admin 管理员组文章数量: 887031
2023年12月18日发(作者:静态方法的区别)
Asp头像上传
本例使用的是艾恩无组件上传类。
演示效果如下:
由于仅仅是个范例所以没有做太多的美化。
本例实现了上传头像更新显示,需要的朋友可以参考下
需要三个文件,一个上传显示页面(),一个弹出上传页面()和一个类页面(UpLoad_)。
以下是代码:
<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
'定义一个编辑变量
Dim MM_editAction
MM_editAction = CStr(Variables("SCRIPT_NAME"))
If (tring <> "") Then
MM_editAction = MM_editAction & "?" & code(tring)
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 = Object ("d")
MM_Connection = conn
MM_dText = "INSERT INTO member (memb_name, memb_header)
VALUES (?, ?)"
MM_ed = true
MM_ MM_Parameter("param1", 202, 1, 50,
("memb_name")) ' adVarWChar
MM_ MM_Parameter("param2", 203, 1,
1073741823, ("memb_header")) ' adLongVarWChar
MM_e
MM_
'完成更新记录操作重定向URL
Dim MM_editRedirectUrl
MM_editRedirectUrl = ""
If (tring <> "") Then
If (InStr(1, MM_editRedirectUrl, "?", vbTextCompare) = 0) Then
MM_editRedirectUrl = MM_editRedirectUrl & "?" & tring
Else
MM_editRedirectUrl = MM_editRedirectUrl & "&" & tring
End If
End If
ct(MM_editRedirectUrl)
End If
End If
%>
<%
set memb=object("set")
sql="SELECT * FROM member order by id desc"
sql,conn,1,3
ze=100 '每页记录数
page=Cint(request("page"))
if page < 1 then page=1
if page > unt then page=unt
tepage=page
%>
"/TR/xhtml1/DTD/">
" alt="<%=memb("memb_name")%>"
title="<%=memb("memb_name")%>" width="50px" height="50px" />
代码开始:
"/TR/xhtml1/DTD/">
<%
if tring("act")="upload" then
Dim Upload,path,tempCls,fName
'===============================================================================
set Upload=new AnUpLoad '创建类实例
Size=1024*1024*1024 '设置单个文件最大上传限制,按字节计;默认为不限制
e=1024*1024*1024 '设置最大上传限制,按字节计;默认为不限制
="bmp|rar|pdf|jpg|gif" '设置合法扩展名,以|分割,忽略大小写
t="gb2312" '设置文本编码,默认为gb2312
ocesser=false '禁止进度条功能,如果启用,需配合客户端程序
a() '获取并保存数据,必须调用本方法
'===============================================================================
if D>0 then '判断错误号,如果<=0表示正常
ption '如果出现错误,获取错误描述
else
if (-1).count>0 then '这里判断你是否选择了文件
path=h("files") '文件保存路径(这里是files文件夹)
'保存文件(以新文件名保存)
set tempCls=("file1")
File path,0
fName=me
set tempCls=nothing
else
"您没有上传任何文件!"
end if
end if
set Upload=nothing '销毁类实例
%>
<-- 上面的这段js代码是把文件的值发送到前一页面的相应标签中
格式是:document.表单是ID.标签的name名.value='files/<%=fName%>';
如果是input表单就写value,如果是图片就写src,类推。
-->
<%
end if
%>
下面这是一个固定的上传类-艾恩无组件上传类。网上可以直接找到源码。
UpLoad_
代码如下:
<%
'=========================================================
'类名: AnUpLoad(艾恩无组件上传类)
'作者: Anlige
'版本: 艾恩无组件上传类V9.9.9
'开发日期: 2008-4-12
'修改日期: 2009-9-9
'作者主页:
'Email: aiener@
'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=object("")
set Form = object("nary")
set Fils = object("nary")
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()
All()
All()
Set Form = Nothing
Set Fils = Nothing
Set StreamT = Nothing
End Sub
'==============================
'函数名:GetData
'作用:处理客户端提交来的所有数据
'==============================
Public Sub GetData()
If vMaxSize > 0 And ytes > vMaxSize Then '判断上传数据总大小
vErr = 1
Exit Sub
End If
if vOP then pID=tring("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
= 1
= 3
TotalBytes = ytes
BytesRead = 0
ChunkReadSize = 1024 * 36
'循环分块读取
Do While BytesRead < TotalBytes
'分块读取
PartSize = ChunkReadSize
If PartSize + BytesRead > TotalBytes Then PartSize = TotalBytes - BytesRead
DataPart = Read(PartSize)
DataPart
BytesRead = BytesRead + PartSize
setApp "uploading",TotalBytes,BytesRead,""
Loop
setApp "uploaded",TotalBytes,BytesRead,""
on = 0
tempdata =
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 (formname) Then
vErr = 4
Exit Sub
Else
Dim fileCls:set fileCls=New fileAction
tType=contentType
= (valueend - formend - 6)
on = (formend + 3)
e = NewName
ame = FileName
formname, fileCls
formname, LocalName
Set fileCls = Nothing
End If
End If
Else
value = MidB(tempdata, formend + 4, valueend - formend - 6)
If (formname) Then
Form(formname) = Form(formname) & "," & Bytes2Str(value)
Else
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,ption
End Sub
Public sub setApp(stp,total,current,desc)
()
Application(pID)="{ID:""" & pID & """,step:""" & stp & """,total:" & total & ",now:" &
current & ",description:""" & desc & """,dt:""" & now() & """}"
()
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 =object("")
= 2
= 3
ext byt
on = 0
t = vCharSet
on = 2
bstr = xt()
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(Variables("REQUEST_METHOD")))
if RequestMethod="" or RequestMethod<>"post" then
checkEntryType = False
exit function
end if
ContentType = LCase(Variables("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 (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 (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 me<>"" then
if File(path,saveType) then
SaveAs=me
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
vPath = Replace(path, "/", "")
If Right(vPath, 1) <> "" Then vPath = vPath & ""
CreateFolder vPath
Dim mystream
Set mystream =object("")
= 1
= 3
on = vPosition
mystream, vSize
vName = vNewName
If saveType = 1 Then vName = vLocalName
File vPath & vName, 2
Set mystream = Nothing
If Err Then
SaveToFile = False
Else
SaveToFile = True
End If
End Function
'==============================
'函数名:GetBytes
'作用:获取文件的二进制形式
'参数:无
'==============================
Public Function GetBytes()
on = vPosition
GetBytes = (vSize)
End Function
'==============================
'函数名:CreateFolder
'作用:自动创建文件夹
'参数:要创建文件夹的路径
'==============================
Private Function CreateFolder(ByVal FolderPath)
on error resume next
Dim FolderArray
Dim i
Dim DiskName
Dim Created
Dim FSO : Set FSO = Object("stemObject")
If Exists(FolderPath) Then
Set Fso = Nothing
Exit Function
End If
FolderPath = Replace(FolderPath, "/", "")
If Mid(FolderPath, Len(FolderPath), 1) = "" Then FolderPath = Mid(FolderPath, 1,
Len(FolderPath) - 1)
FolderArray = Split(FolderPath, "")
DiskName = FolderArray(0)
Created = DiskName
For i = 1 To UBound(FolderArray)
Created = Created & "" & FolderArray(i)
If Not Exists(Created) Then Folder Created
Next
Set FSO = Nothing
End Function
End Class
%>
发表评论