?? uploadhtmls.asp
字號:
<%@ 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
Set Uploader = Nothing
Set IDset = Nothing
Set surc = Nothing
set dest = Nothing
set temp = nothing
response.write "操作成功"
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -