为了正常的体验网站,请在浏览器设置里面开启Javascript功能!

asp头像上传

2013-01-08 17页 doc 161KB 22阅读

用户头像

is_480392

暂无简介

举报
asp头像上传Asp头像上传 本例使用的是艾恩无组件上传类。 演示效果如下: 由于仅仅是个范例所以没有做太多的美化。 本例实现了上传头像更新显示,需要的朋友可以参考下 需要三个文件,一个上传显示页面(pdup.asp),一个弹出上传页面(upload.asp)和一个类页面(UpLoad_Class.inc)。 pdup.asp 以下是代码: "") Then MM_editAction = MM_editAction & "?" & Server.HTMLEncode(Request.QueryString) E...
asp头像上传
Asp头像上传 本例使用的是艾恩无组件上传类。 演示效果如下: 由于仅仅是个范例所以没有做太多的美化。 本例实现了上传头像更新显示,需要的朋友可以参考下 需要三个文件,一个上传显示页面(pdup.asp),一个弹出上传页面(upload.asp)和一个类页面(UpLoad_Class.inc)。 pdup.asp 以下是代码: <%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <% '定义一个编辑变量 Dim MM_editAction MM_editAction = CStr(Request.ServerVariables("SCRIPT_NAME")) If (Request.QueryString <> "") Then MM_editAction = MM_editAction & "?" & Server.HTMLEncode(Request.QueryString) End If ' boolean to abort record edit Dim MM_abortEdit MM_abortEdit = false %> <% If (CStr(Request("MM_insert")) = "upphoto") Then If (Not MM_abortEdit) Then Dim MM_editCmd Set MM_editCmd = Server.CreateObject ("ADODB.Command") MM_editCmd.ActiveConnection = conn MM_editCmd.CommandText = "INSERT INTO member (memb_name, memb_header) VALUES (?, ?)" MM_editCmd.Prepared = true MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param1", 202, 1, 50, Request.Form("memb_name")) ' adVarWChar MM_editCmd.Parameters.Append MM_editCmd.CreateParameter("param2", 203, 1, 1073741823, Request.Form("memb_header")) ' adLongVarWChar MM_editCmd.Execute MM_editCmd.ActiveConnection.Close '完成更新记录操作重定向URL Dim MM_editRedirectUrl MM_editRedirectUrl = "pdup.asp" If (Request.QueryString <> "") Then If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0) Then MM_editRedirectUrl = MM_editRedirectUrl & "?" & Request.QueryString Else MM_editRedirectUrl = MM_editRedirectUrl & "&" & Request.QueryString End If End If Response.Redirect(MM_editRedirectUrl) End If End If %> <% set memb=server.createobject("ADODB.recordset") sql="SELECT * FROM member order by id desc" memb.Open sql,conn,1,3 memb.pagesize=100 '每页记录数 page=Cint(request("page")) if page < 1 then page=1 if page > memb.pagecount then page=memb.pagecount memb.absolutepage=page %> 头像上传



" alt="<%=memb("memb_name")%>" title="<%=memb("memb_name")%>" width="50px" height="50px" />
upload.asp 代码开始: 示例结果
<% if request.QueryString("act")="upload" then Dim Upload,path,tempCls,fName '=============================================================================== set Upload=new AnUpLoad '创建类实例 Upload.SingleSize=1024*1024*1024 '设置单个文件最大上传限制,按字节计;默认为不限制 Upload.MaxSize=1024*1024*1024 '设置最大上传限制,按字节计;默认为不限制 Upload.Exe="bmp|rar|pdf|jpg|gif" '设置合法扩展名,以|分割,忽略大小写 Upload.Charset="gb2312" '设置文本编码,默认为gb2312 Upload.openProcesser=false '禁止进度条功能,如果启用,需配合客户端程序 Upload.GetData() '获取并保存数据,必须调用本方法 '=============================================================================== if Upload.ErrorID>0 then '判断错误号,如果myupload.Err<=0表示正常 response.write Upload.Description '如果出现错误,获取错误描述 else if Upload.files(-1).count>0 then '这里判断你是否选择了文件 path=server.mappath("files") '文件保存路径(这里是files文件夹) '保存文件(以新文件名保存) set tempCls=Upload.files("file1") tempCls.SaveToFile path,0 fName=tempCls.FileName set tempCls=nothing else response.Write "您没有上传任何文件!" end if end if set Upload=nothing '销毁类实例 %> <-- 上面的这段js代码是把文件的值发送到前一页面的相应标签中 格式是:document.表单是ID.标签的name名.value='files/<%=fName%>'; 如果是input表单就写value,如果是图片就写src,类推。 --> <% end if %> 下面这是一个固定的上传类-艾恩无组件上传类。网上可以直接找到源码。 UpLoad_Class.inc 代码如下: <% '========================================================= '类名: AnUpLoad(艾恩无组件上传类) '作者: Anlige '版本: 艾恩无组件上传类V9.9.9 '开发日期: 2008-4-12 '修改日期: 2009-9-9 '作者主页: http://www.ii-home.cn 'Email: aiener@139.com 'QQ: 1034555083 '========================================================= Dim StreamT Class AnUpLoad Private Form, Fils Private vCharSet, vMaxSize, vSingleSize, vErr, vVersion, vTotalSize, vExe, pID,vOP '============================== '设置和读取属性开始 '============================== Public Property Let MaxSize(ByVal value) vMaxSize = value End Property Public Property Let SingleSize(ByVal value) vSingleSize = value End Property Public Property Let Exe(ByVal value) vExe = LCase(value) End Property Public Property Let CharSet(ByVal value) vCharSet = value End Property Public Property Get ErrorID() ErrorID = vErr End Property Public Property Get Description() Description = GetErr(vErr) End Property Public Property Get Version() Version = vVersion End Property Public Property Get TotalSize() TotalSize = vTotalSize End Property Public Property Get ProcessID() ProcessID = pID End Property Public Property Let openProcesser(ByVal value) vOP = value End Property '============================== '设置和读取属性结束,初始化类 '============================== Private Sub Class_Initialize() set StreamT=server.createobject("ADODB.STREAM") set Form = server.createobject("Scripting.Dictionary") set Fils = server.createobject("Scripting.Dictionary") vVersion = "艾恩无组件上传类V9.9.9" vMaxSize = -1 vSingleSize = -1 vErr = -1 vExe = "" vTotalSize = 0 vCharSet = "gb2312" vOP=false pID="AnUpload" setApp "",0,0,"" End Sub Private Sub Class_Terminate() Form.RemoveAll() Fils.RemoveAll() Set Form = Nothing Set Fils = Nothing Set StreamT = Nothing End Sub '============================== '函数名:GetData '作用:处理客户端提交来的所有数据 '============================== Public Sub GetData() If vMaxSize > 0 And Request.TotalBytes > vMaxSize Then '判断上传数据总大小 vErr = 1 Exit Sub End If if vOP then pID=request.querystring("processid") Dim value, str, bcrlf, fpos, sSplit, slen, istart Dim TotalBytes,BytesRead,ChunkReadSize,PartSize,DataPart,tempdata,formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName,localname,type_1,contentType If checkEntryType = True Then vTotalSize = 0 StreamT.Type = 1 StreamT.Mode = 3 StreamT.Open TotalBytes = Request.TotalBytes BytesRead = 0 ChunkReadSize = 1024 * 36 '循环分块读取 Do While BytesRead < TotalBytes '分块读取 PartSize = ChunkReadSize If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead DataPart = Request.BinaryRead(PartSize) StreamT.Write DataPart BytesRead = BytesRead + PartSize setApp "uploading",TotalBytes,BytesRead,"" Loop setApp "uploaded",TotalBytes,BytesRead,"" StreamT.Position = 0 tempdata = StreamT.Read bcrlf = ChrB(13) & ChrB(10) fpos = InStrB(1, tempdata, bcrlf) sSplit = MidB(tempdata, 1, fpos - 1) slen = LenB(sSplit) istart = slen + 2 Do formend = InStrB(istart, tempdata, bcrlf & bcrlf) formhead = MidB(tempdata, istart, formend - istart) str = Bytes2Str(formhead) startpos = InStr(str, "name=""") + 6 endpos = InStr(startpos, str, """") formname = LCase(Mid(str, startpos, endpos - startpos)) valueend = InStrB(formend + 3, tempdata, sSplit) If InStr(str, "filename=""") > 0 Then startpos = InStr(str, "filename=""") + 10 endpos = InStr(startpos, str, """") type_1=instr(endpos,lcase(str),"content-type") contentType=trim(mid(str,type_1+13)) FileName = Mid(str, startpos, endpos - startpos) If Trim(FileName) <> "" Then LocalName = FileName FileName = Replace(FileName, "/", "\") FileName = Mid(FileName, InStrRev(FileName, "\") + 1) setApp "processing",TotalBytes,BytesRead,FileName If instr(FileName,".")>0 Then fileExe = Split(FileName, ".")(UBound(Split(FileName, "."))) else fileExe = "" End If If vExe <> "" Then '判断扩展名 If checkExe(fileExe) = True Then vErr = 3 Exit Sub End If End If NewName = Getname() NewName = NewName & "." & fileExe vTotalSize = vTotalSize + valueend - formend - 6 If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then '判断上传单个文件大小 vErr = 5 Exit Sub End If If vMaxSize > 0 And vTotalSize > vMaxSize Then '判断上传数据总大小 vErr = 1 Exit Sub End If If Fils.Exists(formname) Then vErr = 4 Exit Sub Else Dim fileCls:set fileCls=New fileAction fileCls.ContentType=contentType fileCls.Size = (valueend - formend - 6) fileCls.Position = (formend + 3) fileCls.NewName = NewName fileCls.LocalName = FileName Fils.Add formname, fileCls Form.Add formname, LocalName Set fileCls = Nothing End If End If Else value = MidB(tempdata, formend + 4, valueend - formend - 6) If Form.Exists(formname) Then Form(formname) = Form(formname) & "," & Bytes2Str(value) Else Form.Add formname, Bytes2Str(value) End If End If istart = valueend + 2 + slen Loop Until (istart + 2) >= LenB(tempdata) vErr = 0 Else vErr = 2 End If setApp "processed",TotalBytes,BytesRead,"" if err then setApp "faild",1,0,err.description End Sub Public sub setApp(stp,total,current,desc) Application.lock() Application(pID)="{ID:""" & pID & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}" Application.unlock() end sub '============================== '判断扩展名 '============================== Private Function checkExe(ByVal ex) Dim notIn: notIn = True If vExe="*" then notIn=false elseIf InStr(1, vExe, "|") > 0 Then Dim tempExe: tempExe = Split(vExe, "|") Dim I: I = 0 For I = 0 To UBound(tempExe) If LCase(ex) = tempExe(I) Then notIn = False Exit For End If Next Else If vExe = LCase(ex) Then notIn = False End If End If checkExe = notIn End Function '============================== '把数字转换为文件大小显示方式 '============================== Public Function GetSize(ByVal Size) If Size < 1024 Then GetSize = FormatNumber(Size, 2) & "B" ElseIf Size >= 1024 And Size < 1048576 Then GetSize = FormatNumber(Size / 1024, 2) & "KB" ElseIf Size >= 1048576 Then GetSize = FormatNumber((Size / 1024) / 1024, 2) & "MB" End If End Function '============================== '二进制数据转换为字符 '============================== Private Function Bytes2Str(ByVal byt) If LenB(byt) = 0 Then Bytes2Str = "" Exit Function End If Dim mystream, bstr Set mystream =server.createobject("ADODB.Stream") mystream.Type = 2 mystream.Mode = 3 mystream.Open mystream.WriteText byt mystream.Position = 0 mystream.CharSet = vCharSet mystream.Position = 2 bstr = mystream.ReadText() mystream.Close Set mystream = Nothing Bytes2Str = bstr End Function '============================== '获取错误描述 '============================== Private Function GetErr(ByVal Num) Select Case Num Case 0 GetErr = "数据处理完毕!" Case 1 GetErr = "上传数据超过" & GetSize(vMaxSize) & "限制!可设置MaxSize属性来改变限制!" Case 2 GetErr = "未设置上传表单enctype属性为multipart/form-data或者未设置method属性为Post,上传无效!" Case 3 GetErr = "含有非法扩展名文件!只能上传扩展名为" & Replace(vExe, "|", ",") & "的文件" Case 4 GetErr = "对不起,程序不允许使用相同name属性的文件域!" Case 5 GetErr = "单个文件大小超出" & GetSize(vSingleSize) & "的上传限制!" End Select End Function '============================== '根据日期生成随机文件名 '============================== Private Function Getname() Dim y, m, d, h, mm, S, r Randomize y = Year(Now) m = Month(Now): If m < 10 Then m = "0" & m d = Day(Now): If d < 10 Then d = "0" & d h = Hour(Now): If h < 10 Then h = "0" & h mm = Minute(Now): If mm < 10 Then mm = "0" & mm S = Second(Now): If S < 10 Then S = "0" & S r = 0 r = CInt(Rnd() * 1000) If r < 10 Then r = "00" & r If r < 100 And r >= 10 Then r = "0" & r Getname = y & m & d & h & mm & S & r End Function '============================== '检测上传类型是否为multipart/form-data '============================== Private Function checkEntryType() Dim ContentType, ctArray, bArray,RequestMethod RequestMethod=trim(LCase(Request.ServerVariables("REQUEST_METHOD"))) if RequestMethod="" or RequestMethod<>"post" then checkEntryType = False exit function end if ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE")) ctArray = Split(ContentType, ";") if ubound(ctarray)>=0 then If Trim(ctArray(0)) = "multipart/form-data" Then checkEntryType = True Else checkEntryType = False End If else checkEntryType = False end if End Function '============================== '获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象 '============================== Public Function Forms(ByVal formname) If trim(formname) = "-1" Then Set Forms = Form Else If Form.Exists(LCase(formname)) Then Forms = Form(LCase(formname)) Else Forms = "" End If End If End Function '============================== '获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象 '============================== Public Function Files(ByVal formname) If trim(formname) = "-1" Then Set Files = Fils Else If Fils.Exists(LCase(formname)) Then Set Files = Fils(LCase(formname)) Else Set Files = Nothing End If End If End Function '============================== '简便文件保存函数 '============================== Public Function SaveAs(ByVal formname,ByVal path, ByVal saveType ) dim vfileAction set vfileAction=Files(formname) if vfileAction.FileName<>"" then if vfileAction.SaveToFile(path,saveType) then SaveAs=vfileAction.FileName else SaveAs="Has Error!" end if end if set vfileAction=nothing end function End Class '============================== '文件类,存储文件的详细信息 '============================== Class fileAction Private vSize, vPosition, vName, vNewName, vLocalName, vPath, saveName,vContentType '============================== '设置属性 '============================== Public Property Let NewName(ByVal value) vNewName = value End Property Public Property Get NewName() NewName = vNewName End Property Public Property Let ContentType(vData) vContentType = vData End Property Public Property Get ContentType() ContentType = vContentType End Property Public Property Let LocalName(ByVal value) vLocalName = value vName = value End Property Public Property Get LocalName() LocalName = vLocalName End Property Public Property Get FileName() FileName = vName End Property Public Property Let Position(ByVal value) vPosition = value End Property Public Property Let Size(ByVal value) vSize = value End Property Public Property Get Size() Size = vSize End Property '============================== '函数名:SaveToFile '作用:根据参数保存文件到服务器 '参数:参数1--文件保存的路径 ' 参数2--文件保存的方式,有两个可选项0表示以新名字(时间+随机数)为文件名保存,1表示以原文件名保存文件 '============================== Public Function SaveToFile(ByVal path, ByVal saveType) On Error Resume Next Err.Clear vPath = Replace(path, "/", "\") If Right(vPath, 1) <> "\" Then vPath = vPath & "\" CreateFolder vPath Dim mystream Set mystream =server.createobject("ADODB.Stream") mystream.Type = 1 mystream.Mode = 3 mystream.Open StreamT.Position = vPosition StreamT.CopyTo mystream, vSize vName = vNewName If saveType = 1 Then vName = vLocalName mystream.SaveToFile vPath & vName, 2 mystream.Close Set mystream = Nothing If Err Then SaveToFile = False Else SaveToFile = True End If End Fun
/
本文档为【asp头像上传】,请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑, 图片更改请在作品中右键图片并更换,文字修改请直接点击文字进行修改,也可以新增和删除文档中的内容。
[版权声明] 本站所有资料为用户分享产生,若发现您的权利被侵害,请联系客服邮件isharekefu@iask.cn,我们尽快处理。 本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权,请谨慎使用。 网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传,仅限个人学习分享使用,禁止用于任何广告和商用目的。

历史搜索

    清空历史搜索