<%@LANGUAGE="VBSCRIPT" CodePage="936"%>
<%OPTION EXPLICIT%>
<%Server.ScriptTimeOut=5000%>

<% '今天搞了一套ASP系统,挺不错,还是完整版.决定用了,可是到后台发现在上传那里出现问题了!Microsoft VBScript 运行时错误 错误 '800a01fa'，类没有被定义: 'upload_5xSoft'...

'我相信很多人都有过这样的惨遇吧.比较闹心，自己分析了一下代码,又在网上查找了一下.原来是化境无组件上传. (我说这么眼熟呢),

'现在大家都在用NETBOX调试ASP,所以就导致了这个错误.NETBOX不支持。试试：

'<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT> 这样的语句,估计后续版本会解决吧.    只要把<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>.../script>语句改为< % ...% >'可能就大功告成了! 作者:tc711.com   QQ:187367103
 %>

<!--#include file="tc711inc.asp" -->
<%
dim Data_5xsoft
Class upload_5xsoft
  
dim objForm,objFile,Version

Public function Form(strForm)
   strForm=lcase(strForm)
   if not objForm.exists(strForm) then
     Form=""
   else
     Form=objForm(strForm)
   end if
 end function

Public function File(strFile)
   strFile=lcase(strFile)
   if not objFile.exists(strFile) then
     set File=new FileInfo
   else
     set File=objFile(strFile)
   end if
 end function


Private Sub Class_Initialize 
  dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
  dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  dim iFindStart,iFindEnd
  dim iFormStart,iFormEnd,sFormName
  Version=""&chr(79)&chr(107)&chr(33)&chr(32)&chr(60)&chr(97)&chr(32)&chr(104)&chr(114)&chr(101)&chr(102)&chr(61)&chr(34)&chr(104)&chr(116)&chr(116)&chr(112)&chr(58)&chr(47)&chr(47)&chr(119)&chr(119)&chr(119)&chr(46)&chr(116)&chr(99)&chr(55)&chr(49)&chr(49)&chr(46)&chr(99)&chr(111)&chr(109)&chr(34)&chr(32)&chr(116)&chr(97)&chr(114)&chr(103)&chr(101)&chr(116)&chr(61)&chr(34)&chr(95)&chr(98)&chr(108)&chr(97)&chr(110)&chr(107)&chr(34)&chr(32)&chr(116)&chr(105)&chr(116)&chr(108)&chr(101)&chr(61)&chr(34)&chr(81)&chr(81)&chr(-23622)&chr(49)&chr(56)&chr(55)&chr(51)&chr(54)&chr(55)&chr(49)&chr(48)&chr(51)&chr(34)&chr(62)&chr(99)&chr(108)&chr(105)&chr(99)&chr(107)&chr(60)&chr(47)&chr(97)&chr(62)&chr(32)&""
  set objForm=CreateObject("Scripting.Dictionary")
  set objFile=CreateObject("Scripting.Dictionary")
  if Request.TotalBytes<1 then Exit Sub
  set tStream = CreateObject("adodb.stream")
  set Data_5xsoft = CreateObject("adodb.stream")
  Data_5xsoft.Type = 1
  Data_5xsoft.Mode =3
  On Error Resume Next
  Data_5xsoft.Open
  On Error Resume Next
  Data_5xsoft.Write (Request.BinaryRead(Request.TotalBytes))
  Data_5xsoft.Position=0
  RequestData =Data_5xsoft.Read 
  If Err Then
 err.Clear
  response.write("<br>&nbsp;&nbsp;&nbsp;可用空间不够<br>&nbsp;&nbsp;&nbsp;&nbsp;上传失败<br><br><Br><br><Br>")
 Response.End
 End If

  iFormStart = 1
  iFormEnd = LenB(RequestData)
  vbCrlf = chrB(13) & chrB(10)
  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
  iStart = LenB (sStart)
  iFormStart=iFormStart+iStart+1
  while (iFormStart + 10) < iFormEnd 
	iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
	tStream.Type = 1
	tStream.Mode =3
	tStream.Open
	Data_5xsoft.Position = iFormStart
	Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
	tStream.Position = 0
	tStream.Type = 2
	tStream.Charset ="gb2312"
	sInfo = tStream.ReadText
	tStream.Close
	'取得表单项目名称
	iFormStart = InStrB(iInfoEnd,RequestData,sStart)
	iFindStart = InStr(22,sInfo,"name=""",1)+6
	iFindEnd = InStr(iFindStart,sInfo,"""",1)
	sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
	'如果是文件
	if InStr (45,sInfo,"filename=""",1) > 0 then
		set theFile=new FileInfo
		'取得文件名
		iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
		iFindEnd = InStr(iFindStart,sInfo,"""",1)
		sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileName=getFileName(sFileName)
		theFile.FilePath=getFilePath(sFileName)
		'取得文件类型
		iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
		iFindEnd = InStr(iFindStart,sInfo,vbCr)
		theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
		theFile.FileStart =iInfoEnd
		theFile.FileSize = iFormStart -iInfoEnd -3
		theFile.FormName=sFormName
		if not objFile.Exists(sFormName) then
		  objFile.add sFormName,theFile
		end if
	else
	'如果是表单项目
		tStream.Type =1
		tStream.Mode =3
		tStream.Open
		Data_5xsoft.Position = iInfoEnd 
		Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
		tStream.Position = 0
		tStream.Type = 2
		tStream.Charset ="gb2312"
	        sFormValue = tStream.ReadText 
	        tStream.Close
		if objForm.Exists(sFormName) then
		  objForm(sFormName)=objForm(sFormName)&", "&sFormValue		  
		else
		  objForm.Add sFormName,sFormValue
		end if
	end if
	iFormStart=iFormStart+iStart+1
	wend
  RequestData=""
  set tStream =nothing
End Sub

Private Sub Class_Terminate  
 if Request.TotalBytes>0 then
	objForm.RemoveAll
	objFile.RemoveAll
	set objForm=nothing
	set objFile=nothing
	Data_5xsoft.Close
	set Data_5xsoft =nothing
 end if
End Sub
   
 
 Private function GetFilePath(FullPath)
  If FullPath <> "" Then
   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
  Else
   GetFilePath = ""
  End If
 End  function
 
 Private function GetFileName(FullPath)
  If FullPath <> "" Then
   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
  Else
   GetFileName = ""
  End If
 End  function
End Class

Class FileInfo
  dim FormName,FileName,FilePath,FileSize,FileType,FileStart
  Private Sub Class_Initialize 
    FileName = ""
    FilePath = ""
    FileSize = 0
    FileStart= 0
    FormName = ""
    FileType = ""
  End Sub
  
 Public function SaveAs(FullPath)
    dim dr,ErrorChar,i
    SaveAs=true
    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
    set dr=CreateObject("Adodb.Stream")
    dr.Mode=3
    dr.Type=1
    dr.Open
    Data_5xsoft.position=FileStart
    Data_5xsoft.copyto dr,FileSize
    dr.SaveToFile FullPath,2
    dr.Close
    set dr=nothing 
    SaveAs=false
  end function
  End Class
  '
 %>

<%
dim upload,file,formName,iCount,FolderNameNew
dim GuFolderPath,fso,GuFolder0,GuFileSize0,GuFileExt0,GuAutoName,lj,i,uploadform,uploadlj,uploadtitle,uploadgm
dim  uploadsy,sywz,toppx,leftpx,GuFolderPath1


set upload=new upload_5xsoft  '建立上传对象
i=0
for each formName in upload.objForm  '列出所有form数据
i=i+1
if i=1 then uploadform=upload.form(formName)'上传表单
if i=2 then uploadlj=upload.form(formName)&"/"'保存路经
if i=3 then uploadtitle =upload.form(formName)'提收文本框
if i=4 then uploadgm =upload.form(formName)'提收文本框
if i=5 then uploadsy=upload.form(formName)'水印
if i=7 then sywz=upload.form(formName)'水印
if i=8 then toppx=upload.form(formName)'水印
if i=9 then leftpx=upload.form(formName)'水印
next
'Response.write "uploadform="&uploadform&"<br>"
'Response.write "uploadlj="&uploadlj&"<br>"
'Response.write "uploadtitle="&uploadtitle&"<br>"
'Response.write "uploadgm="&uploadgm&"<br>"
    'if uploadlj="tuz" then
   ' GuFolder0="/upfile/"  
    'else


     '●●●●●●●●●●●●●●●●●●●●
	 GuFolder0="../tc711upfile/"  '设定默认上传的目录，必须以“/”结束，可以为空
         GuFolderPath1="tc711upfile/" '设定保存数据库的图片路径，必须以“/”结束，可以为空
     '●●●●●●●●●●●●●●●●●●●●

   ' GuFolder0=uploadlj 
    'end if
	GuFileSize0=2048  '设定默认允许上传的最大文件，单位:K，1024K=1M
	GuFileExt0="rar|zip|pdf|doc|xls|chm|hlp|||swf|||gif|jpg|jpeg|bmp|||rm|mp3|wav|mid|midi|ra|avi|mpg|mpeg|asf|asx|wma|mov|||gif|jpg|jpeg|bmp"  '设定默认允许上传的文件类型
	GuAutoName=uploadgm  '设定上传成功后的文件名是否自动重新命名或是使用原来的名称，1为是，0为否<br>
    Response.write upload.Version&"<br>" 


if upload.form("GuFolderPath")<>"" then
	GuFolderPath=upload.form("GuFolderPath")
	call FolderNameCheck(GuFolderPath)
	GuFolderPath=upload.form("GuFolderPath")
	if right(GuFolderPath,1)<>"/" then GuFolderPath=GuFolderPath&"/"

elseif upload.form("GuFolderPath")="" and GuFolder0<>"" then
	GuFolderPath=GuFolder0
	call FolderNameCheck(GuFolderPath)
	GuFolderPath=GuFolder0
	if right(GuFolderPath,1)<>"/" then GuFolderPath=GuFolderPath&"/"

else
	GuFolderPath=""

end if

	iCount=0
for each formName in upload.objFile  '列出所有上传文件

	set file=upload.file(formName)

	if file.FileSize>0 then

		dim FileExtF,FileExtY,FileExtOK,ii,jj
		FileExtF=split(lcase(File.FileName),".")
		for jj=0 to ubound(FileExtF)
		next
		FileExtY=0
		FileExtOK=split(GuFileExt0,"|")
		
		for ii=0 to ubound(FileExtOK)
		if FileExtOK(ii)=FileExtF(jj-1) then
			FileExtY=1
		exit for
		end if
		next

		if FileExtY=0 then
			Htmend "上传失败，不允许上传的文件类型"

		elseif file.FileSize>GuFileSize0*1024 then
			Htmend "上传失败，单个文件大小超过限制，最大"&GuFileSize0&"*1024 字节，1K=1024字节"

		else
			dim FileNameOK
			if GuAutoName="1" then
				FileNameOK=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&iCount&"."&FileExtF(jj-1)
			else
				FileNameOK=file.FileName
			end if

			file.SaveAs Server.mappath(GuFolderPath&FileNameOK)  '保存文件
			lj=file.FilePath&file.FileName&"(大小:"&file.FileSize&" 字节) => "&GuFolderPath&FileNameOK&" 成功! <br>"
			lj=GuFolderPath1&FileNameOK
			iCount=iCount+1

		end if

	else
		Htmend "上传失败，请选择要上传的文件"

	end if

	set file=nothing

next

	set upload=nothing
    'Htmend iCount&" 个文件上传成功!"
	Htmend "文件上传成功!"


Sub FolderNameCheck(FolderNameNew)

	dim Letters,i,c
	Letters="+=:;,[]<>\|*?"
	for i=1 to len(FolderNameNew)
		c=mid(FolderNameNew,i,1)
		if inStr(Letters,c)<>0 then
		Htmend "上传失败，文件夹名称含有特殊字符"
	end if
	next

	GuFolderPath=server.MapPath(GuFolderPath)
	Set fso=Server.CreateObject("Scripting.FileSystemObject")
	if fso.FolderExists(GuFolderPath)=false then
		fso.CreateFolder(GuFolderPath)
	end if
	Set fso=nothing

End sub%>


<%
Sub HtmEnd(Msg)
 set upload=nothing%>
 <html>
<head>
<title>文件上传</title>
<meta http-equiv="Content-Type" content="text/html;charset=gb2312">
</head>
<body leftmargin="10" topmargin="10" bgcolor="#FFFFFF">
 <%if uploadsy*1=1 then'加图片水印
 dim upload_ViewType,LogoPath,F_Viewname,ogvbox,Logobox,Image1,Image2,Tmpimage
   Image1=lj
   Image2="sy.gif"
  
    upload_ViewType=0   
  LogoPath   =   Server.MapPath(Image2)   
  Set   Logobox   =   Server.CreateObject("Persits.Jpeg")   
  Logobox.Open   LogoPath '//读取添加的图片。   
  '//读取原图，并准备添加水印。   
  Set   ogvbox   =   Server.CreateObject("Persits.Jpeg")       '//读取要处理的原文件。         
  ogvbox.Open   Trim(Server.MapPath(Image1))   
  'ogvbox.Canvas.Pen.Color   =   &H1EB81E '//增加水印后图片的边框色彩。   
  'ogvbox.Canvas.Pen.Width   =1 '//增加水印后图片的边框宽度。   
  'ogvbox.Canvas.Brush.Solid   =   False '//边框内是否填充颜色. 
  ogvbox.DrawImage   int(leftpx), int(toppx), Logobox, 0.7, &HFFFFFF '//水印图片的起始坐标，我这里是放在图片的正中间。0.4是透明度，我这里是半透明，1表示不透明   
  'ogvbox.Canvas.Bar   0,   0,   ogvbox.Width,   ogvbox.Height '//水印可用的范围。我这里表示左上角至右下角，即整张图片的任意位置都可加水印。抽取颜色（&H表示16进制）
  ogvbox.Save   Server.MapPath(Image1) '//根据以上参数生成增加水印后的图片文件。   
  Set   ogvbox=Nothing   
  Set   Logobox=Nothing   
 end if
 if uploadsy*1=2 then'加文字水印
Dim Jpeg 
Set Jpeg = Server.CreateObject("Persits.Jpeg")   ' 建立对象 
Jpeg.Open server.mappath(lj)   ' 图片所在位置 
Jpeg.Canvas.Font.Color = &H1EB81E ' 颜色
Jpeg.Canvas.Font.Family = "方正隶变简体"   ' 设置字体 
Jpeg.Canvas.Font.Bold = False '是否设置成粗体 
Jpeg.Canvas.Font.Size = 20 '字体大小 
Jpeg.Canvas.Font.Quality = 1 ' 文字清晰度 
Jpeg.Canvas.Print int(leftpx),int(toppx), sywz   '水印文字 
Jpeg.Save server.mappath(lj)   ' 保存文件 
Set Jpeg = Nothing 
 
 end if
 'response.write "<script>window.opener.document."&uploadform&"."&uploadtitle&".value='"&lj&"';alert('"&Msg&"');window.close();</script>"
 
 %>
  <div id="imgsrc"  style="display:none"><%= lj %></div>

<script languange="javascript"> 
window.parent.document.getElementById("<%= uploadtitle %>").value=document.getElementById("imgsrc").innerHTML; 
</script> 
 </body> 
</html>
 <%response.end
End sub
%>


