getfunction.asp

功能介绍： 一、会员功能模块 1、站内短信发布(设计中) 2、书架收藏夹 3、发表评论(功能不完善) 4、申请作家(与添书员整合) 5、申请添书员(与作家整合) 6、申请更新员

						rsfile("fileurl_name")=FileName										'文件名
						rsfile("fileurl_info")=fname										'原名称(远程获取的填写图片连接的绝对地址)
						rsfile("fileurl_user")=douser										'操作人员(采集操作员名字)
						rsfile("fileurl_size")=Getfilesize(fPath & FileName)				'获取文件大小(单位:K)
						rsfile("fileurl_path")=fPath										'文件储存目录
						rsfile("fileurl_class")=sPath										'文件储存类型
						rsfile("fileurl_fileID")=fileID										'调用本文件的目标ID
						rsfile("fileurl_Types")=imgsExt										'文件类型
						rsfile.update														'执行添加操作
						if IsSqlDataBase = 0 then											'如果是ACCESS数据库
							attachid=rsfile("id")											'获取图片在数据库中的唯一ID
						end if
						rsfile.close														'关闭数据库
						if IsSqlDataBase = 1 then											'如果是MSSQL数据库
							rsfile.open strSQL,conn,1,1										'打开数据库(只读模式)
							attachid=rsfile("id")											'获取图片在数据库中的唯一ID
							rsfile.close													'关闭数据库
						end if
					set rsfile=nothing 														'释放数据库资源
					fname1="<img id=attach src="&SiteSystemPath&"attachment.asp?id="&attachid&">"			'格式化html代码,生成新的html代码调用图片
					response.Write "成功！保存到："&fPath & FileName&"&nbsp;&nbsp;↓"
				end if
			else
				response.Write "&nbsp;&nbsp;<font color='red'>失败！</font>&nbsp;&nbsp;目标图片无法获取或网络故障！↓<br>"
				fname1="<img src="&fname&">"
			end if
		End If
		if allimg<>"" then
			allimg=allimg&"||"&Arrimg(Getimagi)												'把保存下来的图片的地址串回起来，以确定要替换的地址
		else
			allimg=Arrimg(Getimagi)
		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(Getimagi)												'把保存下来的图片的地址串回起来，以确定要替换的地址
		else
			allimg=Arrimg(Getimagi)
		end if
		if newimg<>"" then
			newimg=newimg&"||"&fname1														'把新的html代码地址串起来
		else
			newimg=fname1
		end if
	end if
end if
next
response.Write "<br><font color='red'>"&ubound(Arrimgs)&"</font> 张远程图片采集/转换完成<br>开始完成内容入库&nbsp;&nbsp;"
arrnew=split(newimg,"||")																	'取得原来的图片地址列表
arrall=split(allimg,"||")																	'取得已经保存下来的图片的地址列表
for Getimagi=0 to ubound(arrnew)															'循环替换原来的地址
	strs=replace(strs,arrall(Getimagi),arrnew(Getimagi))									'执行替换操作
next
Getimages=strs																				'返回内容资料(html模式)
arrnew=""
arrall=""
newimg=""
allimg=""
End function

'**************************************************
'函数名：GetTextFromHtml
'作  用：从Html标签中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(纯文本内容)
'**************************************************
Public Function GetTextFromHtml(strHtml)
strHtml = Replace(Replace(Replace(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(GetTextFromHtml,"<",""),">","")
End Function

'**************************************************
'函数名：GetTextFHtml
'作  用：从Html标签中取出文本内容
'参  数：strHtml    ----字串资料
'返回值：去掉Html标签的文本文字(含有换行符等分段内容)
'**************************************************
Public Function GetTextFHtml(strHtml)
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)
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
'**************************************************
'函数名：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

%>