网页资讯视频图片知道文库贴吧地图采购
进入贴吧全吧搜索
nom吧 关注：17贴子：96
  • 2回复贴，共1页

无组件上传图片到数据库中，最完整解决方案

收藏回复

  • 218.19.164.*
up.htm

<!--#include file="inc/domin.asp"-->
<!--#include file="conn.asp"-->
<html>
<head>
<title><% =webname %></title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<link rel="stylesheet" href="main.css" type="text/css">
<style type="text/css">
<!--
.tx1 { height: 20px; width: 30px; font-size: 9pt; border: 1px solid; border-color: black black 

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

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

function turnon(obj1,id){
obj1.style.background=bgc_on[id];
}
function turnoff(obj1,id){
obj1.style.background=bgc_off[id];
}

//-->
</script>
<SCRIPT language=javascript>
function check_input() 
{ 
if (Frm.pic.value=="")
{ alert("请选择要上传的图片");
return false;
}
if (Frm.type.value=="")
{ alert("请选择图片类型");
return false;
}
if (Frm.thetext.value=="")
{ alert("请输入照片说明");
return false;
}
return true;
}
</SCRIPT>
</head>

<body bgcolor="#555555" text="#000000" leftmargin="0" topmargin="0">
<table width=755 cellpadding=0 cellspacing=0 border=0 bgcolor=#ffffff align="center">
<tr>
<td height=100><img src="img/top.gif" align="top">
</table>

<!--#include file="inc/mulu.asp"-->


<table width=755 cellpadding=0 cellspacing=0 border=0 bgcolor=#ffffff align="center" bordercolor=#000000>
<tr>
<td height=400 width=180 bgcolor=#D1E9D5 style="border-right: 1px #0E801E solid">
<table width=100% height=100% cellpadding=0 cellspacing=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 height=20 class=L13>
<!--#include file="inc/centermulu.asp"-->
<tr><td height=5>
<tr><td> 
</table>
<td>
<%
set rs=server.createobject("adodb.recordset")
sql="select * from photo where author='"&username&"'"
rs.open sql,conn,1,1
%>
<table cellpadding=0 cellspacing=0 border=0 width=100% height=100%>
<tr><td height=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> 张照片</font> <a href="adminphoto.asp"><font color=red><u>管理以前上传的照片</u></font></a>
<tr><td bgcolor=#ffffff valign=top>
<table cellpadding=0 cellspacing=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 height=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>

1楼2005-04-23 19:48回复
    • 218.19.164.*

    Set Fields = CreateObject("Scripting.Dictionary")

    Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
    'Header and file/source field data
    Dim HeaderContent, FieldContent
    'Header fields
    Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
    'Helping variables
    Dim Field, TwoCharsAfterEndBoundary
    'Get end of header
    PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

    'Separates field header
    HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

    'Separates field content
    FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

    'Separates header fields from header
    GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

    'Create one field and assign parameters
    Set Field = CreateUploadField()
    Field.Name = FormFieldName
    Field.ContentDisposition = Content_Disposition
    Field.FilePath = SourceFileName
    Field.FileName = GetFileName(SourceFileName)
    Field.ContentType = Content_Type
    Field.value = FieldContent
    Field.Length = LenB(FieldContent)


    Fields.Add FormFieldName, Field

    'Is this ending boundary ?
    TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
    'Binary.Mid(PosCloseBoundary + Len(Boundary), 2).String
    isLastBoundary = TwoCharsAfterEndBoundary = "--"
    If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
    PosOpenBoundary = PosCloseBoundary
    PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
    End If
    Loop
    Set SeparateFields = Fields
    End Function

    '********************************** Utilities **********************************
    Function BinaryToString(str)
    strto = ""
    for i=1 to lenb(str)
    if AscB(MidB(str, i, 1)) > 127 then
    strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
    i = i + 1
    else
    strto = strto & Chr(AscB(MidB(str, i, 1)))
    end if
    next
    BinaryToString=strto
    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

    'Separates header fields from upload header
    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

    'Separets one filed between sStart and 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)
    
    3楼2005-04-23 19:48
    回复
      • 119.131.228.*
      可以加你的qq吗？
      我的qq是284951380
      5楼2009-05-03 23:42
      回复

        扫二维码下载贴吧客户端

        下载贴吧APP
        看高清直播、视频！
        • 2回复贴，共1页
        发表回复
        发贴请遵守贴吧协议及“七条底线”贴吧投诉
        内  容:
          查看全部
        发 表
        保存至快速回贴