Subir imágenes a la base de datos sin componentes, la solución más completa

Autor：Eve Cole Fecha de actualización：2009-06-23 16:59:05

arriba.htm

<html>
<cabeza>
<título><% =nombre web %></título>
<meta http-equiv="Tipo de contenido" content="text/html; charset=gb2312">
<enlace rel="hoja de estilo" href="main.css" tipo="texto/css">
<tipo de estilo="texto/css">
<!--
.tx1 { altura: 20px; ancho: 30px; tamaño de fuente: 9 puntos; borde: 1px sólido; color del borde: negro negro

#000000; color: #0000FF}
-->
</estilo>

función activada(obj1,id){
obj1.style.background=bgc_on[id];
}
función de apagado (obj1, id) {
obj1.style.background=bgc_off[id];
}

//-->
</script>
<Idioma SCRIPT=javascript>
función check_input()
{
si (Frm.pic.value=="")
{ alerta("请选择要上传的图片");
devolver falso;
}
si (Frm.tipo.valor=="")
{ alerta("请选择图片类型");
devolver falso;
}
si (Frm.thetext.value=="")
{ alerta("请输入照片说明");
devolver falso;
}
devolver verdadero;
}
</SCRIPT>
</head>

<ancho de tabla=755 relleno de celdas=0 espacio entre celdas=0 borde=0 bgcolor=#ffffff align="center" bordercolor=#000000>
<tr>
<td altura=400 ancho=180 bgcolor=#D1E9D5 estilo="borde-derecho: 1px #0E801E sólido">
<ancho de tabla=100% alto=100% relleno de celda=0 espacio entre celdas=0 borde=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 clase=L13>

<tr><td altura=5>
<tr><td>
</tabla>
<td>
<%
establecer rs=servidor.createobject("adodb.recordset")
sql="seleccione * de la foto donde autor='"&nombre de usuario&"'"
rs.open sql, conexión, 1,1
%>
<tabla cellpadding=0 espacio entre celdas=0 borde=0 ancho=100% alto=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=arriba>
<table cellpadding=0 cellspaceing=0 border=0 ancho=95% alto=100% align="center">
<formulario acción=addphoto.asp método=nombre de la publicación=Frm onSubmit="return check_input()" enctype="multipart/form-data">
<tr><td altura=20 colspan=2>
<tr><td altura=25 ancho=15% align="right" clase=L13>选择照片： <td> <input NAME="pic" TYPE="FILE" class="tx1" style="ancho:300 "> <font color=red>拒绝色情、写真图等</font>

</tabla>

</cuerpo>
</html>

fupload.inc

<SCRIPT RUNAT=IDIOMA DEL SERVIDOR=VBSCRIPT>
'限制上传图片大小
Dim UploadSizeLimit

'************************************ 得到上传数据 ********** *************************
Función ObtenerCargar()
Resultado oscuro
Establecer resultado = Nada
Si Request.ServerVariables("REQUEST_METHOD") = "POST" Entonces 'el método de solicitud debe ser "POST"
Dim CT, PosB, Límite, Longitud, PosE
CT = Request.ServerVariables("HTTP_Content_Type") 'lee el encabezado Content-Type
Si LCase(Left(CT, 19)) = "multipart/form-data" Entonces 'el encabezado del tipo de contenido debe ser "multipart/form-data"
'Esta es la solicitud de carga.
'Obtiene el límite y la longitud del encabezado Content-Type
PosB = InStr(LCase(CT), "boundary=") 'Encuentra el límite
Si PosB > 0 Entonces Límite = Mid(CT, PosB + 9) 'Límite separado
Longitud = CLng(Request.ServerVariables("HTTP_Content_Length")) 'Obtener encabezado de longitud del contenido
si "" & UploadSizeLimit<>"" entonces
SubirTamañoLimit = clng(SubirTamañoLimit)
si Longitud > UploadSizeLimit entonces
' en caso de error, reanudar siguiente 'Borra el búfer de entrada
'respuesta.AddHeader "Conexión", "Cerrar"
' en caso de error ir a 0
Solicitud.BinaryRead(Longitud)
Err.Raise 2, "GetUpload", "Tamaño de carga" & FormatNumber(Length,0) & "B excede el límite de" & FormatNumber(UploadSizeLimit,0) & "B"
función de salida
terminar si
end if

Si Longitud > 0 Y Límite <> "" Entonces '¿Hay información requerida sobre la carga?
Límite = "--" & Límite
Cabeza tenue, binario
Binary = Request.BinaryRead(Length) 'Lee datos binarios del cliente

'Recupera los campos de carga de datos binarios
Establecer resultado = campos separados (binario, límite)
Binario = Vacío 'Borrar variables
Demás
Err.Raise 10, "GetUpload", "Solicitud de longitud cero".
Terminar si
Demás
Err.Raise 11, "GetUpload", "No se envió ningún archivo".
Terminar si
Demás
Err.Raise 1, "GetUpload", "Método de solicitud incorrecto".
Terminar si
Establecer GetUpload = Resultado
Función final

Función Campos Separados(Binario, Límite)
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Campos oscuros
Límite = StringToBinary(Límite)

PosOpenBoundary = InstrB(Binario, Límite)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Establecer campos = CreateObject("Scripting.Dictionary")

Hacer mientras (PosOpenBoundary > 0 y PosCloseBoundary > 0 y no isLastBoundary)
'Datos del campo de encabezado y archivo/fuente
Contenido de encabezado tenue, contenido de campo
'Campos de encabezado
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Variables de ayuda
Campo oscuro, TwoCharsAfterEndBoundary
'Obtener el final del encabezado
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separa el encabezado del campo
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separa el contenido del campo
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separa los campos de encabezado del encabezado
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Crea un campo y asigna parámetros
Establecer campo = CreateUploadField()
Campo.Nombre = Nombre de campo de formulario
Field.ContentDisposition = Contenido_Disposición
Field.FilePath = NombreDeArchivoFuente
Field.FileName = GetFileName(SourceFileName)
Campo.ContentType = Tipo_Contenido
Campo.Valor = Contenido del campo
Campo.Longitud = LenB(Contenido del campo)

Fields.Add FormFieldName, campo

'¿Es este límite final?
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
isLastBoundary = TwoCharsAfterEndBoundary = "--"
Si no esLastBoundary Entonces 'Este no es el límite final; vaya al siguiente campo del formulario.
PosOpenBoundary = PosCerrarLímite
PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Límite), Binario, Límite)
Terminar si
Bucle
Establecer campos separados = campos
Función final

'************************************ Utilidades *********** **********************
Función BinaryToString(cadena)
strto = ""
para i=1 a lenb(cadena)
si AscB(MidB(str, i, 1)) > 127 entonces
strto = strto & chr(Ascb(MidB(cadena, i, 1))*256+Ascb(MidB(cadena, i+1, 1)))
yo = yo + 1
demás
strto = strto & Chr(AscB(MidB(cadena, i, 1)))
terminar si
próximo
BinaryToString=cadena
Función final

Función StringToBinary(String)
Oscuro I, B
Para I=1 a len(String)
B = B y ChrB(Asc(Medio(Cadena,I,1)))
Próximo
CadenaABinario = B
Función final

'Separa los campos del encabezado del encabezado de carga
Función GetHeadFields (ByVal Head, Content_Disposition, Nombre, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Nombre = (SeparateField(Head, "nombre=", ";")) 'ltrim
Si Izquierda(Nombre, 1) = """" Entonces Nombre = Medio(Nombre, 2, Len(Nombre) - 2)
Nombre de archivo = (SeparateField(Head, "nombre de archivo=", ";")) 'ltrim
Si Left(FileName, 1) = """" Entonces FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "tipo de contenido:", ";"))
Función final

'Separa un archivo entre sStart y sEnd
Función CampoSeparado(Desde, ByVal sStart, ByVal sEnd)
Atenuar PosB, PosE, sFrom
sDe = LCaso(De)
PosB = InStr(sDesde, sInicio)
Si PosB > 0 entonces
PosB = PosB + Len(sInicio)
PosE = InStr(PosB, sFrom, enviar)
Si PosE = 0 Entonces PosE = InStr(PosB, sFrom, vbCrLf)
Si PosE = 0 Entonces PosE = Len(sFrom) + 1
CampoSeparado = Medio(Desde, PosB, PosE - PosB)
Demás
CampoSeparado = Vacío
Terminar si
Función final

'Separa el nombre del archivo de la ruta completa del archivo
Función ObtenerNombreDeArchivo(RutaCompleta)
Pos tenue, PosF
PosF = 0
Para Pos = Len (ruta completa) a 1 paso -1
Seleccione Caso Medio (Ruta Completa, Pos, 1)
Caso "/", "": PosF = Pos + 1: Pos = 0
Finalizar selección
Próximo
Si PosF = 0 Entonces PosF = 1
GetFileName = Medio (Ruta completa, PosF)
Función final
</SCRIPT>
<SCRIPT RUNAT=IDIOMA DEL SERVIDOR=JSCRIPT>
//La función crea el objeto Campo.
función CreateUploadField(){ devolver nuevo uf_Init() }
función uf_Init(){
this.Name = nulo
this.ContentDisposition = nulo
this.FileName = nulo
this.FilePath = nulo
this.ContentType = nulo
this.Value = nulo
this.Longitud = nulo
}
</SCRIPT>

agregarfoto.asp



<%
si Request.ServerVariables("REQUEST_METHOD") = "POST" Entonces
Campos oscuros
Límite de tamaño de carga=100000
Establecer campos = GetUpload()
campo oscuro
Para cada campo en Fields.Items
seleccione caso Campo.nombre
caso "el texto" sss=BinaryToString(Field.value)
caso "tipo" fff=BinaryToString(Field.value)
caso "enviar" enviar = BinaryToString (Field.value)
caso "foto"
nombre de archivo = campo.Nombre de archivo
fileContentType=campo.ContentType
valor de archivo = campo.valor
finalizar seleccionar
próximo
'-----------------------
si nombre de archivo<>"" y fileContentType<>"image/gif" y

fileContentType<>"image/pjpeg" entonces
%>
<centro>
<br><br>
<font color=red size=3>上传的照片应该为GIF或JPG文件！</font><br><br>
<tipo de entrada="botón" valor="重填" onclick="history.go( -1 );return

true;">
</centro>
<%
demás
'------------
'开始输入
'------------
respuesta.escribir sss
respuesta.escribir"<br>"
respuesta.escribir fff
establecer rs=servidor.createobject("ADODB.recordset")
sql = "seleccione * de tb donde el id es nulo"
rs.Abrir sql,conn,3,3
rs.añadirnuevo
rs("autor")=nombre de usuario
rs("eltexto")=sss
rs("tipos")=fff
rs("golpes")=1
rs("hora de publicación")=ahora()
rs("foto").appendchunk filevalue

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

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

action="personinf.asp"><input type="enviar" valor="返回"></form>
</centro>
<%
terminar si
terminar si
%>

showpic.asp

<%
id=Solicitud("id")
establecer rs=server.CreateObject("adodb.recordset")
sql="SELECCIONAR * DE tb donde elid="&id
rs.Abrir sql,conn,1,3
respuesta.contenttype="imagen/gif"
Response.BinaryWrite rs("foto")
%>