getfunction.asp

小说站源代码文件

						rsfile.update														'执行添加操作
						rsfile.close														'关闭数据库
						rsfile.open strSQL,conn,1,1											'打开数据库(只读模式)
							attachid=rsfile("id")											'获取图片在数据库中的唯一ID
						rsfile.close														'关闭数据库
					set rsfile=nothing 														'释放数据库资源
					fname1="<img id=attach src="&SiteSystemPath&"attachment.asp?id="&attachid&">"			'格式化html代码,生成新的html代码调用图片
					response.Write "成功！"
				end if
			else
				response.Write "　<font color='red'>失败！</font>　目标图片无法获取或网络故障！"
				fname1="<img src="&fname&">"
			end if
		End If
		if allimg<>"" then
			allimg=allimg&"||"&Arrimg(Gtimgi)												'把保存下来的图片的地址串回起来，以确定要替换的地址
		else
			allimg=Arrimg(Gtimgi)
		end if
		if newimg<>"" then
			newimg=newimg&"||"&fname1														'把新的html代码地址串起来
		else
			newimg=fname1
		end if
	ElseIf fname<>"$False$" and fname<>"" and SaveTf=False Then								'如果不保存图片
		fname1="<img src="&fname&">"
		if allimg<>"" then
			allimg=allimg&"||"&Arrimg(Gtimgi)												'把保存下来的图片的地址串回起来，以确定要替换的地址
		else
			allimg=Arrimg(Gtimgi)
		end if
		if newimg<>"" then
			newimg=newimg&"||"&fname1														'把新的html代码地址串起来
		else
			newimg=fname1
		end if
	end if
end if
next
response.Write "		<font color='blue'> → </font>图片采集/转换完成 → 完成内容入库"
arrnew=split(newimg,"||")																	'取得原来的图片地址列表
arrall=split(allimg,"||")																	'取得已经保存下来的图片的地址列表
for Gtimgj=0 to ubound(arrnew)															'循环替换原来的地址
	strs=replace(strs,arrall(Gtimgj),arrnew(Gtimgj))									'执行替换操作
next
Getimages=strs																				'返回内容资料(html模式)
arrnew=""
arrall=""
newimg=""
allimg=""
End function

'**************************************************
'函数名：GetTextFromHtml
'作  用：从Html标签中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(纯文本内容)
'**************************************************
Public Function GetTextFromHtml(strHtml)
if strHtml="" or isnull(strHtml) then Exit Function
strHtml = Replace(Replace(Replace(Replace(trim(strHtml), chr(10), ""), chr(13), ""), vbCrLf, ""),"'", "’")
Dim strPatrn
	strPatrn = "<.*?>"
Dim regEx
Set regEx = New RegExp
regEx.Pattern = strPatrn
regEx.IgnoreCase = True
regEx.Global = True
GetTextFromHtml = regEx.Replace(strHtml, "")
Set regEx = Nothing
GetTextFromHtml = Replace(Replace(Replace(Replace(GetTextFromHtml,"<","〈"),">","〉"),"&nbsp;"," "),"""","‘’")
End Function

'**************************************************
'函数名：GetTextFHtml
'作  用：从Html标签中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(含有换行符等分段内容)
'**************************************************
Public Function GetTextFHtml(strHtml)
if strHtml="" or isnull(strHtml) then Exit Function
strHtml = Replace(Replace(Replace(Replace(strHtml, "<br>", vbCrLf), "<BR>", vbCrLf), "</p>", vbCrLf & vbCrLf), "</P>", vbCrLf & vbCrLf)
Dim strPatrn
	strPatrn = "<.*?>"
Dim regEx
Set regEx = New RegExp
regEx.Pattern = strPatrn
regEx.IgnoreCase = True
regEx.Global = True
GetTextFHtml = regEx.Replace(strHtml, "")
Set regEx = Nothing
End Function

'**************************************************
'函数名：GetTextFrHtml
'作  用：从Html标签中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(含有"<br>"内容)
'**************************************************
Public Function GetTextFrHtml(strHtml)
if strHtml="" or isnull(strHtml) then Exit Function
strHtml = Replace(Replace(Replace(Replace(Replace(Replace(strHtml, "<br>", "[br]"), "<BR>", "[br]"), "</p>", "[br]"), "</P>", "[br]"), "<br />", "[br]"), "<BR />", "[br]")
Dim strPatrn
	strPatrn = "<.*?>"
Dim regEx
Set regEx = New RegExp
regEx.Pattern = strPatrn
regEx.IgnoreCase = True
regEx.Global = True
GetTextFrHtml = regEx.Replace(strHtml, "")
Set regEx = Nothing
GetTextFrHtml=Replace(GetTextFrHtml, "[br]", "<br>")
End Function

'**************************************************
'函数名：GetTxtHtml
'作  用：从Html中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(含有换行符等分段内容)
'**************************************************
Public Function GetTxtHtml(strHtml)
if strHtml="" or isnull(strHtml) then Exit Function
strHtml = replace(replace(replace(Replace(Replace(Replace(Replace(strHtml, "<br>", chr(13)&chr(10)), "<BR>", chr(13)&chr(10)), "<p>", chr(13)&chr(10)), "<P>", chr(13)&chr(10)),"document.write('",""),"');",""),"&nbsp;"," ")
Dim strPatrn, regEx
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
	strPatrn = "<img.+?>"
regEx.Pattern = strPatrn
strHtml = regEx.Replace(strHtml, "『图片内容,需要从网站"&Siteurl&"阅读』")
	strPatrn = "<.*?>"
regEx.Pattern = strPatrn
GetTxtHtml = regEx.Replace(strHtml, "")
Set regEx = Nothing
End Function

'**************************************************
'函数名：GetcutStr
'作  用：截取指定长度字符串
'参  数：str       ----字串资料
'参  数：strlen    ----截取长度
'返回值：截取到的字符串
'**************************************************
Public Function GetcutStr(str, strlen)
If str="" or isnull(str) then Exit Function
Dim l, t, c, i
l = Len(str)
t = 0
For i = 1 To l
c = Abs(Asc(Mid(str, i, 1)))
If c > 255 Then
	t = t + 2
Else
	t = t + 1
End If
If t >= strlen Then
	GetcutStr = Left(str, i) & ".."
	Exit For
Else
	GetcutStr = str
End If
Next
GetcutStr = Replace(GetcutStr, Chr(10), "")
End Function

%>