<!--#include file="../p_inc/Include_func.asp"-->
<!--#include file="../p_inc/openconn.asp"-->
<%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'*******************   无惧上传类 V1.2  ************************************
'作者:梁无惧
'网站:http://www.hacom.cn
'电子邮件:poesy@126.com
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.并且保留作者此版权信息
'**********************************************************************
'----------------------------------------------------------------------
Dim oUpFileStream
'----------------------------------------------------------------------
'文件上传类
Class UpFile_Class

Dim Form,File,Version,Err 

Private Sub Class_Initialize
 Version = "无惧上传类 Version V1.2"
 Err = -1
End Sub

Private Sub Class_Terminate  
  '清除变量及对像
  If Err < 0 Then
    Form.RemoveAll
    Set Form = Nothing
    File.RemoveAll
    Set File = Nothing
    oUpFileStream.Close
    Set oUpFileStream = Nothing
  End If
End Sub
   
Public Sub GetData (MaxSize)
  '定义变量
  Dim RequestBinData,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
  Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
  Dim iFindStart,iFindEnd
  Dim iFormStart,iFormEnd,sFormName
  '代码开始
  If Request.TotalBytes < 1 Then  '如果没有数据上传
    Err = 1
    Exit Sub
  End If
  If MaxSize > 0 Then '如果限制大小
    If Request.TotalBytes > MaxSize Then
    Err = 2	'如果上传的数据超出限制
    Exit Sub
    End If
  End If
  Set Form = Server.CreateObject ("Scripting.Dictionary")
  Form.CompareMode = 1
  Set File = Server.CreateObject ("Scripting.Dictionary")
  File.CompareMode = 1
  Set tStream = Server.CreateObject ("adodb.stream")
  Set oUpFileStream = Server.CreateObject ("adodb.stream")
  oUpFileStream.Type = 1
  oUpFileStream.Mode = 3
  oUpFileStream.Open 
  oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
  oUpFileStream.Position = 0
  RequestBinData = oUpFileStream.Read 
  iFormEnd = oUpFileStream.Size
  bCrLf = ChrB (13) & ChrB (10)
  '取得每个项目之间的分隔符
  sSpace = MidB (RequestBinData,1, InStrB (1,RequestBinData,bCrLf)-1)
  iStart = LenB  (sSpace)
  iFormStart = iStart+2
  '分解项目
  Do
    iInfoEnd = InStrB (iFormStart,RequestBinData,bCrLf & bCrLf)+3
    tStream.Type = 1
    tStream.Mode = 3
    tStream.Open
    oUpFileStream.Position = iFormStart
    oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
    tStream.Position = 0
    tStream.Type = 2
    tStream.CharSet = "gb2312"
    sInfo = tStream.ReadText     
	 
    '取得表单项目名称
    iFormStart = InStrB (iInfoEnd,RequestBinData,sSpace)-1
    iFindStart = InStr (22,sInfo,"name=""",1)+6
    iFindEnd = InStr (iFindStart,sInfo,"""",1)
    sFormName = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
    '如果是文件
    If InStr  (45,sInfo,"filename=""",1) > 0 Then
      Set oFileInfo = new FileInfo_Class
      '取得文件属性
      iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
      iFindEnd = InStr (iFindStart,sInfo,"""",1)
      sFileName = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
      oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, "\")+1)
      oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, "\"))
      oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, ".")+1)
      iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
      iFindEnd = InStr (iFindStart,sInfo,vbCr)
      oFileInfo.FileType = Mid  (sinfo,iFindStart,iFindEnd-iFindStart)
      oFileInfo.FileStart = iInfoEnd
      oFileInfo.FileSize = iFormStart -iInfoEnd -2
      oFileInfo.FormName = sFormName
      file.add sFormName,oFileInfo
    else
    '如果是表单项目
      tStream.Close
      tStream.Type = 1
      tStream.Mode = 3
      tStream.Open
      oUpFileStream.Position = iInfoEnd 
      oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
      tStream.Position = 0
      tStream.Type = 2
      tStream.CharSet = "gb2312"
      sFormValue = tStream.ReadText
      If Form.Exists (sFormName) Then
        Form (sFormName) = Form (sFormName) & ", " & sFormValue
        else
        form.Add sFormName,sFormValue
      End If
    End If
    tStream.Close
    iFormStart = iFormStart+iStart+2
    '如果到文件尾了就退出
  Loop Until  (iFormStart+2) >= iFormEnd 
  RequestBinData = ""
  Set tStream = Nothing
End Sub
End Class

'------------------------------------------------------------------------------
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt
'保存文件方法
Public Function SaveToFile (Path)
  On Error Resume Next
  Dim oFileStream
  Set oFileStream = CreateObject ("adodb.stream")
  oFileStream.Type = 1
  oFileStream.Mode = 3
  oFileStream.Open
  oUpFileStream.Position = FileStart
  oUpFileStream.CopyTo oFileStream,FileSize
  oFileStream.SaveToFile Path,2
  oFileStream.Close
  Set oFileStream = Nothing 
End Function
 
'取得文件数据
Public Function FileData
  oUpFileStream.Position = FileStart
  FileData = oUpFileStream.Read (FileSize)
End Function

End Class

Function Qingtiandy_BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        Qingtiandy_BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function
%>

<%




set upload=new upfile_class ''建立上传对象
upload.GetData(1048576)   '取得上传数据,限制最大上传10M

FoundErr=False

for each formName in upload.file '列出所有上传了的文件
	set ofile=upload.file(formName)  '生成一个文件对象
	ooFileData=ofile.FileData
	
	fileExt=lcase(ofile.FileExt)
	UpFileType="htm"
	arrUpFileType=split(UpFileType,",")
	for i=0 to ubound(arrUpFileType)
		if fileEXT=trim(arrUpFileType(i)) then
			EnableUpload=true
			exit for
		end if
	next	
	if EnableUpload=false then
		msg="这种文件类型不允许上传！\n\n只允许上传这几种文件类型：" & UpFileType
		FoundErr=true
	End IF
	
	IF FoundErr Then
		Response.Write "<script>alert('"&msg&"');parent.location.reload()</scr"&"ipt>"
		Response.End()
	End IF
	
	ppStr=Qingtiandy_BytesToBstr(ooFileData,"gb2312")
	kk_1=""
	kk_2=ppStr
	Set soojs = New Regexp'设置配置对象
	soojs.IgnoreCase = True'忽略大小写
	soojs.Global = True'设置为全文搜索
	soojs.Pattern =  "<DT><H3"&"(\n|.)*?"&"\n    </DL><p>"'正则表达式 
	Set Matches =soojs.Execute(ppStr)'开始执行配置
	set  soojs=nothing 
	kk_1=""
	For Each Match in Matches
		kk_1=kk_1&Match.Value&"<hr>" '循环匹配
		kk_2=Replace(kk_2,Match.Value,"")
	Next
	'kk_1 
	'kk_2
	'n_nub
	l=""
	n_nub=0
	kk_1_a=Split(kk_1,"<hr>")
	For ii=0 To Ubound(kk_1_a)-1
		m1=kk_1_a(ii)
		m1_1=GetContent(m1,"<DT><H3","/H3>",0)
		m1_1=GetContent(m1_1,">","<",0)
		l=l&"<dl>"&vbcrlf
		IF m1_1<>"" Then
			l=l&"	<dt>"&vbcrlf
			l=l&"		<input type=""checkbox"" checked onclick=""chk_all("&ii&",this.checked)"" name=""fold["&ii&"]"" value="""&m1_1&""" />"&m1_1&vbcrlf
			l=l&"	</dt>"&vbcrlf
			h=body2s(m1,"<DT>","</A>","####",false)
			ha=split(h,"####")
			For jj=0 To Ubound(ha)-1
				h1=ha(jj)
				k1_1=GetContent(h1,"<DT><A HREF=","</A>",1)
				k1_1=LoseeHtml(k1_1)
				k1_2=GetContent(h1,"HREF=""","""",0)
				l=l&"<dd>"&vbcrlf
				l=l&"<input type=""checkbox"" checked name=""url_key["&ii&"]["&jj&"]"" value="""&k1_2&"^^"&k1_1&"""/><a href="""&k1_2&""" target=_blank>"&k1_1&"</a>"&vbcrlf
				l=l&"</dd>"&vbcrlf
				n_nub=n_nub+1
			Next
		End IF
		l=l&"</dl>"
	Next
	
	ii=Ubound(kk_1_a)
	m1_1="未分类"
	IF kk_2<>"" Then
		l=l&"<dl>"&vbcrlf
		l=l&"	<dt>"&vbcrlf
		l=l&"		<input type=""checkbox"" checked onclick=""chk_all("&ii&",this.checked)"" name=""fold["&ii&"]"" value="""&m1_1&""" />"&m1_1&vbcrlf
		l=l&"	</dt>"&vbcrlf
		h=body2s(kk_2,"<DT>","</A>","####",false)
		ha=split(h,"####")
		For jj=0 To Ubound(ha)-1
			h1=ha(jj)
			k1_1=GetContent(h1,"<DT><A HREF=","</A>",1)
			k1_1=LoseeHtml(k1_1)
			k1_2=GetContent(h1,"HREF=""","""",0)
			l=l&"<dd>"&vbcrlf
			l=l&"<input type=""checkbox"" checked name=""url_key["&ii&"]["&jj&"]"" value="""&k1_2&"^^"&k1_1&"""/><a href="""&k1_2&""" target=_blank>"&k1_1&"</a>"&vbcrlf
			l=l&"</dd>"&vbcrlf
			n_nub=n_nub+1
		Next
		l=l&"</dl>"&vbcrlf
	End IF
	mm_1=N_Fso.ReadAllTextFile("inputs.asp")
	mm_1=Replace(mm_1,"{#qTcms.folder#}",l)
	mm_1=Replace(mm_1,"{#qTcms.n_nub#}",n_nub)
	Response.Write mm_1
next


%>

<%
Function GetContent(str,start,last,n)
	If Instr(lcase(str),lcase(start))>0 and Instr(lcase(str),lcase(last))>0 then
		select case n
		case 0	'左右都截取（都取前面）（去处关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))-1)
		case 1	'左右都截取（都取前面）（保留关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		GetContent=Left(GetContent,Instr(lcase(GetContent),lcase(last))+Len(last)-1)
		case 2	'只往右截取（取前面的）（去除关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
		case 3	'只往右截取（取前面的）（包含关键字）
		GetContent=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
		case 4	'只往左截取（取后面的）（包含关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))+Len(start)-1)
		case 5	'只往左截取（取后面的）（去除关键字）
		GetContent=Left(str,InstrRev(lcase(str),lcase(start))-1)
		case 6	'只往左截取（取前面的）（包含关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))+Len(start)-1)
		case 7	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start))+1)
		case 8	'只往左截取（取前面的）（去除关键字）
		GetContent=Left(str,Instr(lcase(str),lcase(start))-1)
		case 9	'只往右截取（取后面的）（包含关键字）
		GetContent=Right(str,Len(str)-InstrRev(lcase(str),lcase(start)))
		end select
	Else
		GetContent=""
	End if
End function

Function body2s(wstr,start,over,str,tag)
	Dim start1,over1
	start1=replace(replace(replace(replace(replace(replace(start,"(","\("),")","\)"),"?","\?"),"$","\$"),"[","\["),"]","\]")
	over1=replace(replace(replace(replace(replace(over,"(","\("),")","\)"),"?","\?"),"[","\["),"]","\]")
	Set soojs = New Regexp'设置配置对象
	soojs.IgnoreCase = True'忽略大小写
	soojs.Global = True'设置为全文搜索
	soojs.Pattern =  ""&start1&"(\n|.)*?"&over1'正则表达式 
	Set Matches =soojs.Execute(wstr)'开始执行配置
	set  soojs=nothing 
	body2s=""
	For Each Match in Matches
	body2s=body2s&Match.Value&str '循环匹配
	Next
	IF tag Then
		body2s=replace(body2s,start,"")
		body2s=replace(body2s,over,"")
	End IF
End Function

Function LoseeHtml(ContentStr)
 Dim ClsTempLoseStr,regEx
 ClsTempLoseStr = Cstr(ContentStr)
 Set regEx = New RegExp
 regEx.Pattern = "<\/*[^<>]*>"       ' 设置模式
 regEx.IgnoreCase = True         ' 设置是否区分字符大小写。
 regEx.Global = True             ' 设置全局可用性。
 ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")        '意思是在ClsTempLoseStr中凡是有regEx.Pattern标签的全部用“”代替
 LoseeHtml = ClsTempLoseStr
End Function
%>