uploadhtmls.asp.bak

本示例综合展示了NTKO OFFICE文档控件所具有的发布为HTML

<%@ Language=VBScript %>

<!--#include file="conn.asp"-->
<!-- #include file="upload.asp" -->

<%
		Function GetLastID( TableName,FieldName )
			Dim SQL,RS
			Dim CurID
			
			SQL = "SELECT MAX("+FieldName+") as MaxID from " + TableName
			set RS = conn.Execute( SQL )
			CurID = RS("MaxID")
			RS.Close	
			Set RS = Nothing
			GetLastID = CurID
		End Function
	 
	  Function CByteString(sString)
			Dim nIndex
			For nIndex = 1 to Len(sString)
		  	 CByteString = CByteString & ChrB(AscB(Mid(sString,nIndex,1)))
			Next
		End Function
		
		

Dim Uploader, File
Dim RS,SQL
Dim CurHtmlName,CurSrcName, RefHtmlID

'创建文件上载对象,FileUploader类在upload.asp中定义
Set Uploader = New FileUploader

'设置表单的字符集
Uploader.FormCharSet = "gb2312"

'执行上载
Uploader.Upload()

'检查是否有上载的文件
If Uploader.Files.Count = 0 Then
	Response.Write "没有上载的HTML文件."
Else
	If Uploader.Form("htmlid") <> "" Then          ' 编辑文件
		 SQL = "DELETE FROM sources WHERE reference = " & Uploader.Form("htmlid")
		 conn.execute( SQL )
	End If
	If Uploader.Form("docid") <> "" Then
		 SQL = "DELETE FROM htmls WHERE ffid = " & Uploader.Form("docid")	
		 conn.execute( SQL )
	End If
	
	set IDset = Server.CreateObject("Scripting.Dictionary")
	
	For Each File In Uploader.Files.Items
			If Instr( File.filename ,".html" )Then		' 保存html文件			
				 CurHtmlName = File.Filename						
				 Set	RS = Server.CreateObject("ADODB.Recordset")
				 RS.Open	"htmls", conn, adOpenDynamic, adLockOptimistic	
				 RS.AddNew
				 RS("fname")	  =	CurHtmlName
				 If Uploader.Form("title") <> "" Then
				 		RS("title") = Uploader.Form("title")
				 End If
				 If Uploader.Form("docid") <> "" Then
				 		RS("ffid") = Uploader.Form("docid")
				 End If
				 RS.Update
				 RS.Close
				 set RS = Nothing
				 RefHtmlID = GetLastID("htmls","fid")				 ' 获得新增记录的ID
					
			Else			'保存资源文件
			  
				 CurSrcName = File.Filename
				 Set	RS = Server.CreateObject("ADODB.Recordset")
				 RS.Open	"sources", conn, adOpenDynamic, adLockOptimistic	
				 RS.AddNew
				 RS("sname")	  =	 CurSrcName
				 RS("reference") = RefHtmlID
				 File.SaveToDatabase	RS("scontent")
			   RS.Update
			   RS.Close
				 set RS = Nothing
				 maxID = GetLastID("sources","sid")
			   IDSet.ADD CStr(maxID),CurSrcName 
			      
				
		 End IF	 		
	'response.write File.Filename + "上传成功<br>"
	Next
	
	set surc = Server.CreateObject("ADODB.Stream")
			surc.Type = 1
			surc.Mode = 3
			surc.Open
	
	
	
	For Each File In Uploader.Files.Items	 
			If Instr( File.filename ,".html" )Then	
				 surc.write File.Filedata
			   Exit For
			End if
  Next
  surc.position = 0
  
  Dim buff
  
 
  
  Dim index, srcname
  index = IDSet.keys
  srcname = IDSet.items

set temp = Server.CreateObject("ADODB.Stream")
			temp.Type = 1
			temp.Mode = 3
			temp.Open

set find = Server.CreateObject("ADODB.Stream")
			find.Type = 1
			find.Mode = 3
			find.Open
set replacement = Server.CreateObject("ADODB.Stream")
			replacement.type =1
			replacement.mode = 3
			replacement.open
temp.position = 0
For i=0 To IDSet.count - 1
 		surc.position = 0
 		buff = surc.read
		replacement.position = 0
		replacement.type = 2
		replacement.writetext CByteString(chr(34)&"readimage.asp?id=" & index(i)&chr(34) )
		replacement.position = 0
		replacement.type = 1
		replacement.position = 2
		
		surc.position = 0
		start = 1
		searchstr = CByteString(chr(34)&srcname(i)&chr(34)) 
		mark = InStrB( start, buff,  searchstr )
		Do While mark <> 0  
		   
		   temp.write surc.read( mark - start )
			 temp.write replacement.read
			 replacement.position = 2
			 start = LenB(searchstr ) + mark
			 mark = InStrB( start, buff, searchstr )
			 surc.position = start-1
		Loop
		
		temp.write surc.read( LenB(buff) - start + 1 )	
		surc.position = 0
		temp.position = 0
		surc.seteos
		surc.write temp.read 
		temp.position = 0
		temp.seteos
'	exit for	
		
Next	

surc.position = 0

	Set	RS = Server.CreateObject("ADODB.Recordset")
	RS.Open	"htmls", conn, adOpenDynamic, adLockOptimistic
	RS.find "fid=" & RefHtmlID
	RS("fcontent").AppendChunk surc.read 
	RS.Update
	set RS = Nothing
End If

surc.position =0
surc.savetofile "e:\temp\aa"
Set Uploader = Nothing
Set IDset = Nothing
Set surc = Nothing
set dest = Nothing
set temp = nothing
response.write "操作成功"

%>