asp无组件上传并插入到数据库里

网络整理 - 09-07

以下为引用的内容：
<%
Response.Buffer = True
Server.ScriptTimeOut=9999999
On Error Resume Next

%>


<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "">
<html xmlns="">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
<meta http-equiv="Content-Language" content="zh-cn" />
<meta content="all" name="robots" />
<style type="text/css">

</style>
<title>ASP文件上传</title>
</head>
<body id="body">
<%
checkuser()

ExtName = "xls" '允许扩展名
SavePath = "upload" '保存路径
If Right(SavePath,1)<>"/" Then SavePath=SavePath&"/" '在目录后加(/)
CheckAndCreateFolder(SavePath)

UpLoadAll_a = Request.TotalBytes '取得客户端全部内容
If(UpLoadAll_a>0) Then
    Set UploadStream_c = Server.CreateObject("ADODB.Stream")
    UploadStream_c.Type = 1
    UploadStream_c.Open
    UploadStream_c.Write Request.BinaryRead(UpLoadAll_a)
    UploadStream_c.Position = 0

    FormDataAll_d = UploadStream_c.Read
    CrLf_e = chrB(13)&chrB(10)
    FormStart_f = InStrB(FormDataAll_d,CrLf_e)
    FormEnd_g = InStrB(FormStart_f+1,FormDataAll_d,CrLf_e)

    Set FormStream_h = Server.Createobject("ADODB.Stream")
    FormStream_h.Type = 1
    FormStream_h.Open
    UploadStream_c.Position = FormStart_f + 1
    UploadStream_c.CopyTo FormStream_h,FormEnd_g-FormStart_f-3
    FormStream_h.Position = 0
    FormStream_h.Type = 2
    FormStream_h.CharSet = "GB2312"
    FormStreamText_i = FormStream_h.Readtext
    FormStream_h.Close

FileName_j = Mid(FormStreamText_i,InstrRev(FormStreamText_i,"")+1,FormEnd_g)

If(CheckFileExt(FileName_j,ExtName)) Then
SaveFile = Server.MapPath(SavePath & FileName_j)

      If Err Then
        Response.Write "文件上传： <span style=""color:red;"">文件上传出错!</span>　<a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
        Err.Clear
      Else
        SaveFile = CheckFileExists(SaveFile)

SaveFileName = Mid(SaveFile,InstrRev(SaveFile,"")+1)
session("file")=SaveFileName

   k=Instrb(FormDataAll_d,CrLf_e&CrLf_e)+4
        l=Instrb(k+1,FormDataAll_d,leftB(FormDataAll_d,FormStart_f-1))-k-2
        FormStream_h.Type=1
        FormStream_h.Open
        UploadStream_c.Position=k-1
        UploadStream_c.CopyTo FormStream_h,l
        FormStream_h.SaveToFile SaveFile,2

        SaveFileName = Mid(SaveFile,InstrRev(SaveFile,"")+1)

Dim Conn1,Driver1,DBPath1,Rs1,Sql1
' 建立Connection对象
Set Conn1 = Server.CreateObject("ADODB.Connection")
Driver1 = "Driver={Microsoft Excel Driver (*.xls)};"
DBPath1 = "DBQ=" & Server.MapPath("upload/"&SaveFileName)

'调用Open 方法打开数据库
Conn1.Open Driver1 & DBPath1

Sql1="Select * From [Sheet1$] "
Set Rs1=Conn1.Execute(Sql1)

IF Rs1.Eof And Rs1.Bof Then
Response.write "没有找到您需要的数据!!"
Else
Do While Not Rs1.EOF

   '插入到数据库中


    OpenDataBase "select * from abc"

     if len(rs1(0))=7 then

      ctime=left(rs1(0),4)
     else

      ctime=left(rs1(0),5)
     end if

     rs.addnew
     rs("time")=ctime
     rs.update
     CloseDataBase()


Rs1.MoveNext
Loop
End IF

Rs1.Close
Set Rs1=nothing
Conn1.Close
Set Conn1=Nothing

'插入到数据库中结束

Response.write "文件上传： <span style=""color:red;"">" & SaveFileName & " </span>文件上传成功!<a href='choise.asp''>继续上传文件</a><br />"
      End If
    Else
      Response.write "文件上传： <span style=""color:red;"">文件格式不正确!</span>　<a href=""" & Request.ServerVariables("URL") &""">重新上传文件</a><br />"
    End If

Else
%>
<script language="Javascript">

</script>
<form action='<%= Request.ServerVariables("URL") %>' method='post' name="upform" onsubmit="return ValidInput()" enctype="multipart/form-data">
文件上传：
<input type='file' size="40"> <input type='submit' value="上传">
</form>
<%
End if
Set FormStream_h = Nothing
UploadStream.Close
Set UploadStream = Nothing
%>
</body>
</html>