upfile.asp

教师评估系统

<%
'On Error Resume Next
Dim BadExt,SizeBool,SizeDesc,ExtBool,ExtDesc
BadExt="|ida|idq|htw|stm|printer|cfm|cdx|cer|html|htm|php|php2|php3|php4|php5|phtml|pwml|inc|asp|aspx|ascx|jsp|cfc|pl|vbs|js|cgi|htaccess|hta|htr|asis|sh|shtml|shtm|phtm|"
SizeDesc=""
ExtDesc=""

sub ChkSize(Size)
 if Size<1 Then
  SizeBool=False
  SizeDesc="当前文件为空文件"
  Exit sub
 ElseIf Size>UpMaxFileSize Then
  SizeBool=False
  SizeDesc="文件大小不得超过 "&CheckSize(UpMaxFileSize)&"\n当前的文件大小为 "&CheckSize(Size)&""
  Exit sub
 Else
  SizeBool=True
 end if
end sub

sub ChkExt(Ext)
 if Instr(BadExt,"|"&Ext&"|")>0 Then
  ExtBool=False
  ExtDesc="对不起，本论坛不允许上传 "&Ext&" 格式的文件"
  Exit sub
 ElseIf UpClass="Face" Then
  if Split(FileMIME,"/")(0)<>"image" Then
   ExtBool=False
   ExtDesc="头像只允许上传图像文件"
   Exit sub
  ElseIf Instr("|gif|jpg|jpeg|","|"&LCase(Ext)&"|")<=0 Then
   ExtBool=False
   ExtDesc="请上传gif或jpg格式的头像"
   Exit sub
   Else
    ExtBool=True
   end if
   ElseIf Instr("|"&LCase(Cache("UploadExt"))&"|","|"&LCase(Ext)&"|") <=0 Then
    ExtBool=False
	ExtDesc="对不起，本论坛不允许上传 "&Ext&" 格式的文件"
   Else
    ExtBool=True
 end if
end sub

Function str2bin(varstr) 
str2bin="" 
For i=1 To Len(varstr) 
varchar=mid(varstr,i,1) 
varasc = Asc(varchar) 
if varasc<0 Then varasc = varasc + 65535
if varasc>255 Then 
	varlow = Left(Hex(Asc(varchar)),2) 
	varhigh = right(Hex(Asc(varchar)),2) 
	str2bin = str2bin & chrB("&H" & varlow) & chrB("&H" & varhigh) 
Else 
	str2bin = str2bin & chrB(Asc(varchar)) 
end if 
Next
end Function

sub CheckFile()
ChkSize(FileSize)
ChkExt(FileExt)
if Not SizeBool Then ShowErr(SizeDesc)
if Not ExtBool Then ShowErr(ExtDesc)
if UpClass<>"Face" then
TotalUserPostAttachments=Conn.Execute("select sum(ContentSize) from [WxUpFiles] where UserName='"&CookieUserName&"'")(0)
if Cache("Maxup") then
updatamax=Conn.Execute("select Maxup from [WxRoles] where id="&UserRoleID)(0)
else
updatamax=int(Cache("MaxAffixSize"))
end if
if TotalUserPostAttachments+FileSize>updatamax Then ShowErr("您的上传空间已满！")
end if
end sub

sub ShowErr(Msg)
 Set obj=Nothing
 if UpClass="Face" Then
  Alert(Msg)
 Else
  Error2(Msg)
end if
end sub

Select case Cache("UploadObj")
case ""
Error2("对不起，管理员关闭文件上传功能")
case "ADODB.Stream"
set obj=new upfile_class				'建立上传对象
obj.GetData ()					'取得上传数据
FileName=obj.file("file").FileName			'文件名
FileExt=Lcase(obj.file("file").FileExt)		'小写后缀名
FileMIME=obj.file("file").FileMIME			'文件类型
FileSize=obj.file("file").FileSize			'文件大小
SaveFile=""&UpFolder&"."&FileExt&""			'保存文件路径
CheckFile()
obj.SaveToFile "file",Server.mappath(""&SaveFile&"")
Set obj=Nothing
case "SoftArtisans.FileUp"
Set obj = Server.CreateObject("SoftArtisans.FileUp")
FileName=obj.ShortFilename				'文件名
FileExt=Lcase(mid(FileName,InstrRev(FileName, ".")+1))	'小写后缀名
FileMIME=obj.ContentType				'文件类型
FileSize=obj.TotalBytes				'文件大小
SaveFile=""&UpFolder&"."&FileExt&""			'保存文件路径
CheckFile()
obj.SaveAs Server.MapPath(""&SaveFile&"")
Set obj=Nothing
case "Persits.Upload"
Set obj=Server.CreateObject("Persits.Upload")
obj.OverwriteFiles = False '能覆盖
obj.IgnoreNoPost = True
obj.SetMaxSize ChkNumeric(UpMaxFileSize), True
FileCount=obj.Save()
if Err.Number=8 Then
 ShowErr("文件大小不得超过 "&CheckSize(UpMaxFileSize))
Else
if Err.Number<>0 Then ShowErr(Err.Description)
For Each File In obj.Files
 FileName=File.Filename
 FileSize=File.Size
 FileMIME=File.ContentType
 FileExt=LCase(Replace(File.Ext,".",""))
 SaveFile=UpFolder&"."&FileExt
 ExtResult=CheckFileExtra(FileExt)
 if Err.Number<>0 Then Error2(Err.Number&"\n"&Err.Description)
 CheckFile()
 File.SaveAs Server.Mappath(SaveFile)
Next
end if
Set obj=Nothing
end Select

if Cache("WMObj")="Persits.Jpeg" and (FileMIME="image/pjpeg" Or FileMIME="image/jpeg") and UpClass<>"Face" then
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Jpeg.Open Server.MapPath(""&SaveFile&"")

if Cache("WMType")=0 then
Jpeg.Canvas.Font.Color = Replace(Cache("WMColor"),"#","&H")	'颜色
Jpeg.Canvas.Font.Family = Cache("WMFont")  	'字体
Jpeg.Canvas.Font.size = Cache("WMSize")		'大小
if Cache("WMBold") Then
 Bold=True
Else
 Bold=False
end if
Jpeg.Canvas.Font.Bold = Bold		'是否加粗
Jpeg.Canvas.Print 10, 10, ""&Cache("WMText")&""

elseif Cache("WMType")=1 then
Set Jpeg2 = Server.CreateObject("Persits.Jpeg")
Jpeg2.Open Server.MapPath(Cache("WMImg"))
select case Cache("WMPosition")
case "0"
Imagewidth=10
Imageheight=10
case "1"
Imagewidth=10
Imageheight=Jpeg.Originalheight-Jpeg2.Originalheight-10
case "2"
Imagewidth=(Jpeg.Originalwidth-Jpeg2.Originalwidth)/2
Imageheight=(Jpeg.Originalheight-Jpeg2.Originalheight)/2
case "3"
Imagewidth=Jpeg.Originalwidth-Jpeg2.Originalwidth-10
Imageheight=10
case "4"
Imagewidth=Jpeg.Originalwidth-Jpeg2.Originalwidth-10
Imageheight=Jpeg.Originalheight-Jpeg2.Originalheight-10
end select
Jpeg.Canvas.DrawImage Imagewidth, Imageheight, Jpeg2, Cache("WMExtent"), &HFFFFFF
end if

Jpeg.Save Server.MapPath(""&SaveFile&"")
Set Jpeg = Nothing
end if

if UpClass<>"Face" then
Rs.Open "[WxUpFiles]",Conn,1,3 
Rs.addnew 
Rs("UserName")=CookieUserName
Rs("FileName")=FileName
Rs("ContentType")=FileMIME
Rs("ContentSize")=FileSize
Rs("FilePath")=SaveFile
Rs("Class")=UpClass
Rs("Category")=""
Rs.update
AttachmentID=Rs("id")
Rs.close
end if
%>