Upload de imagens para banco de dados sem componentes, a solução mais completa

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

up.htm

<html>
<cabeça>
<title><% =nome da web %></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<style type="texto/css">
<!--
.tx1 {altura: 20px; largura: 30px; tamanho da fonte: 9pt; borda: 1px sólido; cor da borda: preto preto

#000000; cor: #0000FF}
-->
</style>

<linguagem script="JavaScript">
<!--
var bgc_on=new Array("#74D738","#FF9C17","#3278AB","#486177","#078C00","#007ECA")
var bgc_off=new Array("#4CAD12","FFB859","5F9FD0","577590","08A700","009FFF")

função turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
função desligar(obj1,id){
obj1.style.background=bgc_off[id];
}

//-->
</script>
<linguagem SCRIPT=javascript>
função verificação_input()
{
se (Frm.pic.value=="")
{ alert("请选择要上传的图片");
retornar falso;
}
if (Frm.type.value=="")
{ alert("请选择图片类型");
retornar falso;
}
if (Frm.thetext.value=="")
{ alert("请输入照片说明");
retornar falso;
}
retornar verdadeiro;
}
</SCRIPT>
</head>

<largura da tabela=755 cellpadding=0 cellpacing=0 border=0 bgcolor=#ffffff align="center" bordercolor=#000000>
<tr>
<td height=400 width=180 bgcolor=#D1E9D5 style="border-right: 1px #0E801E solid">
<largura da tabela=100% altura=100% cellpadding=0 cellpacing=0 border=0 align="center" bordercolor=#000000>
<tr><td height=30 align="center" class=L15><font color=#E96D08>欢迎你：<% =username %> 管理中心</font>
<tr><td height=23 align="center" class=L15 bgcolor=#4CAD12 style="border-top:0px #0E801E solid; border-bottom:1px #0E801E solid;"><font color=#C2F009 class =yinying>管理中心</font>
<tr><td altura=20 classe=L13>

<tr><td altura=5>
<tr><td>
</tabela>
<td>
<%
definir rs=server.createobject("adodb.recordset")
sql="selecione * da foto onde autor='"&nomedeusuário&"'"
rs.open sql,conn,1,1
%>
<table cellpadding=0 cellpacing=0 border=0 width=100% height=100%>
<tr><td altura=3>
<tr><td height=3 bgcolor=#ffffff background=img/bj3.gif>
<tr><td height=20 valign="bottom" bgcolor=#eeeeee> 现在位置： 98243班 - 管理中心 - 添加新闻
<tr><td height=3 bgcolor=#eeeeee style="border-bottom: 1px #cccccc solid"><p style="font-size:1pt">
<tr><td height=20 valign="bottom"> <font color=green><% =username %>：你一共上传了 <font color=red><% =rs.recordcount %></font> 张Foto</font> <a href="adminphoto.asp"><font color=red><u>管理以前上传的照片</u></font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellpacing=0 border=0 width=95% height=100% align="center">
<form action=addphoto.asp method=post name=Frm onSubmit="return check_input()" enctype="multipart/form-data">
<tr><td altura=20 colspan=2>
<tr><td height=25 width=15% align="right" class=L13>选择照片： <td> <input NAME="pic" TYPE="FILE" class="tx1" style="width:300 "> <font color=red>拒绝色情、写真图等</font>

</tabela>

</body>
</html>

fupload.inc

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上传图片大小
Dim UploadSizeLimit

'********************************** 得到上传数据 ********** ************************
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
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

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
Campo.Comprimento = 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>

addfoto.asp



<%
se Request.ServerVariables("REQUEST_METHOD") = "POST" Então
Campos escuros
UploadSizeLimit=100000
Definir campos = GetUpload()
campo escuro
Para cada campo em Fields.Items
selecione o caso Campo.nome
case "thetext" sss=BinaryToString(Field.value)
case "tipo" fff=BinaryToString(Field.value)
caso "enviar" enviar=BinaryToString(Field.value)
caso "foto"
nome do arquivo = campo.Nome do arquivo
fileContentType = campo.ContentType
valor do arquivo=campo.valor
final selecionar
próximo
'---------------
se filename<>"" e fileContentType<>"image/gif" e

fileContentType<>"image/pjpeg" então
%>
<centro>
<br><br>
<font color=red size=3>上传的照片应该为GIF或JPG文件！</font><br><br>
<input type="button" value="重填" onclick="history.go( -1 );return

true;">
</centro>
<%
outro
'------------
'开始输入
'-----------
resposta.write sss
resposta.write"<br>"
resposta.write fff
definir rs=server.createobject("ADODB.recordset")
sql = "selecione * de tb onde o id é nulo"
rs.Abrir sql,conn,3,3
rs.addnew
rs("autor")=nome de usuário
rs("otexto")=sss
rs("tipos")=fff
rs("acertos")=1
rs("posttime")=agora()
rs("foto").appendchunk filevalue

rs.update
rs.fechar
%>
<br><br>
<center><font color=red

size=3>成功输入个人基本档案！</font><br><br><form method="post"

action="personinf.asp"><input type="submit" value="返回"></form>
</centro>
<%
terminar se
terminar se
%>

showpic.asp

<%
id=Solicitação("id")
definir rs=server.CreateObject("adodb.recordset")
sql="SELECT * FROM tb onde theid="&id
rs.Abrir sql,conn,1,3
resposta.contenttype = "imagem/gif"
Response.BinaryWrite rs("foto")
%>