getfunction.asp

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

for Getimagi=1 to ubound(Arrimg)
if arrimg(Getimagi)<>"" and instr(allimg,Arrimg(Getimagi))<1 then				'判断这个图片是否已经下载过
	fname=Replace(Replace(Arrimg(Getimagi),"[/img]",""),"[img]","")				'获取图片正确连接地址
	fileExt=split(fname,".")
	imgsExt=fileExt(ubound(fileExt))											'获取图片后缀
	randomize
	ranNum=int(90000*rnd)+10000													'生成随机数字,以防止文件重名
	Filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&imgsExt
	If SaveRemoteFile(fPath & FileName,fname,fname)=True Then					'采集图片,将图片保存到本地
		If not CheckFileType(Server.mappath(fPath & FileName)) then				'判断是否为图片格式文件,如果不是图片格式
			Set fso = CreateObject("Scripting.FileSystemObject")				'设置FSO操作
				Set ficn = fso.GetFile(Server.mappath(fPath & FileName))		'删除刚才上传的图片
					ficn.delete													'执行删除操作
				set ficn=nothing												'释放删除动作资源
			set fso=nothing														'关闭FSO操作,释放FSO操作资源
			fname1="[img]"&fname&"[/img]"										'返回错误的提示信息
		else																	'如果是图片格式,继续操作
			set rsfile=server.createobject("adodb.recordset") 					'设置数据库连接类型.然后打开数据库,将图片资料录入数据库
			strSQL ="select top 1 id,fileurl_info,fileurl_name,fileurl_user,fileurl_size,fileurl_path,fileurl_class,fileurl_fileID,fileurl_Types from [filetest] where fileurl_class="&sPath&" and fileurl_name='"&FileName&"' order by id desc"
			rsfile.open strSQL,conn,1,3											'打开数据库表(可修改模式)
				rsfile.addnew													'添加新数据
				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="[attachimg]attachment.asp?id="&attachid&"[/attachimg]"		'格式化UBB代码,生成新的UBB代码调用图片
		end if
	End If
	allimg=allimg&"||"&Arrimg(Getimagi)											'把保存下来的图片的地址串回起来，以确定要替换的地址
	newimg=newimg&"||"&fname1													'把新的UBB代码地址串起来
end if
next
arrnew=split(newimg,"||")														'取得原来的图片地址列表
arrall=split(allimg,"||")														'取得已经保存下来的图片的地址列表
for Getimagi=1 to ubound(arrnew)												'循环替换原来的地址
	strs=replace(strs,arrall(Getimagi),arrnew(Getimagi))						'执行替换操作
next
Getimgs=strs																	'返回内容资料(UBB模式)
arrnew=""
arrall=""
newimg=""
allimg=""
end function

'**************************************************
'函数名：Getimages
'作  用：远程获取内容资料中的图片并下载到本地(html模式:绝对地址"允许";相对地址"允许")
'参  数：strs    ----内容资料
'        douser  ----操作人员(上传或采集操作员)
'        fPath   ----图片保存目录
'        sPath   ----图片保存位置类型
'        fileID  ----调用本图片的章节ID
'        SaveTf  ----是否保存图片，False不保存，True保存
'        TistUrl ----当前网页地址()
'返回值：已经格式化替换过连接的内容资料
'**************************************************
function Getimages(strs,douser,fPath,sPath,fileID,SaveTf,TistUrl)
Set objRegExp = New Regexp																	'设置配置对象
objRegExp.IgnoreCase = True																	'忽略大小写
objRegExp.Global = True																		'设置为全文搜索
objRegExp.Pattern = "<img.+?>"																'取出图片地址配置：找到里面的<im>标签取出里面的图片地址
Set Matches =objRegExp.Execute(strs)														'开始执行配置
For Each Match in Matches
	if RetStr<>"" Then
		RetStr = RetStr&"||"&left(Match.Value,len(Match.Value))								'把包含图片地址的内容串起来备用
	Else
		RetStr=Match.Value
	End if
Next
Arrimg=split(RetStr,"||")																	'分割字串，取得里面包含图片地址的内容列表   
For Tempi=0 To Ubound(Arrimg)
	objRegExp.Pattern ="src\s*=\s*.+?\.(gif|jpg|bmp|jpeg|png|tiff)"							'取得图片正确的地址
	Set Matches =objRegExp.Execute(Arrimg(Tempi)) 
	For Each Match in Matches
		if TempStr<>"" Then
			TempStr=TempStr & "$Array$" & Match.Value										'把图片正确地址串起来备用
		Else
			TempStr=Match.Value
		End if
	Next
Next

If TempStr<>"" Then
	objRegExp.Pattern ="src\s*=\s*"
	TempStr=objRegExp.Replace(TempStr,"")													'处理图片地址串,清除不需要的内容
End If
If TempStr="" or IsNull(TempStr)=True Then
	Getimages=strs
	Exit function
End if

TempStr=Replace(TempStr,"""","")
TempStr=Replace(TempStr,"'","")
TempStr=Replace(TempStr," ","")

TempArray=Split(TempStr,"$Array$")															'为转换相对图片相对地址,分割字串，取得里面图片地址列表

TempStr=""
For Tempi=0 To Ubound(TempArray)
	TempStr=TempStr & "||" & DefiniteUrl(TempArray(Tempi),TistUrl)							'转换相对图片相对地址为绝对地址
Next
'TempStr=Right(TempStr,Len(TempStr)-7)
'TempStr=Replace(TempStr,Chr(0),"")

Arrimgs=split(TempStr,"||")																	'把图片绝对地址串起来备用

TempStr=""
																							'转换相对图片地址结束
allimg=""																					'已经保存的图片统计参数(原文件统计)
newimg=""																					'已经保存的图片统计参数(新文件统计)
response.Write "<br>发现内容中存在 <font color='red'>"&ubound(Arrimgs)&"</font> 张远程图片"
for Getimagi=0 to ubound(Arrimg)
fname=Arrimgs(Getimagi+1)																	'获取图片正确连接地址
if arrimg(Getimagi)<>"" and instr(allimg,Arrimg(Getimagi))<1 then							'判断这个图片是否已经下载过
	If fname<>"$False$" and fname<>"" And SaveTf=True Then									'如果保存图片

		response.Write "<br>"&Getimagi+1&"图片："&fname										'输出获取到的图片地址

		fileExt=split(fname,".")
		imgsExt=fileExt(ubound(fileExt))													'获取图片后缀
		randomize
		ranNum=int(90000*rnd)+10000															'生成随机数字,以防止文件重名
		Filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"."&imgsExt
		response.Write "<br>采集"
		If Not CreateMultiFolder(fPath) Then
			response.Write "&nbsp;&nbsp;<font color='red'>失败！</font>&nbsp;&nbsp;创建图片存放目录“"&fPath&"”失败，可能是由于服务器限制！！↓<br>"
			fname1="<img src="&fname&">"
		else
			If SaveRemoteFile(fPath & FileName,fname,TistUrl)=True Then						'采集图片,将图片保存到本地
				If not CheckFileType(Server.mappath(fPath & FileName)) then					'判断是否为图片格式文件,如果不是图片格式
					Set fso = CreateObject("Scripting.FileSystemObject")					'设置FSO操作
						Set ficn = fso.GetFile(Server.mappath(fPath & FileName))			'删除刚才上传的图片
							ficn.delete														'执行删除操作
						set ficn=nothing													'释放删除动作资源
					set fso=nothing															'关闭FSO操作,释放FSO操作资源
					fname1="<img src="&fname&">"											'返回错误的提示信息
					response.Write "&nbsp;&nbsp;<font color='red'>失败！</font>&nbsp;&nbsp;目标图片类型错误！↓<br>"
				else																		'如果是图片格式,继续操作
					set rsfile=server.createobject("adodb.recordset") 						'设置数据库连接类型.然后打开数据库,将图片资料录入数据库
					strSQL ="select top 1 id,fileurl_info,fileurl_name,fileurl_user,fileurl_size,fileurl_path,fileurl_class,fileurl_fileID,fileurl_Types from [filetest] where fileurl_class="&sPath&" and fileurl_name='"&FileName&"' order by id desc"
					rsfile.open strSQL,conn,1,3												'打开数据库表(可修改模式)
						rsfile.addnew														'添加新数据