红金羚企业管理系统REDERP红金羚企业管理系统

源代码在线查看: replaceremoteurl.asp

软件大小: 3898 K
上传用户: z3021440
关键词: REDERP 金羚 企业管理
下载地址: 免注册下载 普通下载 VIP

相关代码

								'================================================
				'作  用:替换字符串中的远程文件为本地文件并保存远程文件
				'参  数:
				'	sHTML		: 要替换的字符串
				'	sSavePath	: 保存文件的路径
				'	sExt		: 执行替换的扩展名
				'================================================
				Function eWebEditor_ReplaceRemoteUrl(sHTML, sSavePath, sExt)
					Dim s_Content
					s_Content = sHTML
					If eWebEditor_IsObjInstalled("Microsoft.XMLHTTP") = False then
						eWebEditor_ReplaceRemoteUrl = s_Content
						Exit Function
					End If
					
					If sSavePath = "" Then sSavePath = "/eWebEditor/UploadFile/"
					If sExt = "" Then sExt = "jpg|gif|bmp|png"
					Dim re, RemoteFile, RemoteFileurl, SaveFileName, SaveFileType, ranNum
					Set re = new RegExp
					re.IgnoreCase  = True
					re.Global = True
					re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(" & sExt & ")))"
					Set RemoteFile = re.Execute(s_Content)
					For Each RemoteFileurl in RemoteFile
						SaveFileType = Mid(RemoteFileurl, InstrRev(RemoteFileurl, ".") + 1)
						Randomize
						ranNum = Int(900 * Rnd) + 100
						SaveFileName = sSavePath & year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & ranNum & "." & SaveFileType
						Call eWebEditor_SaveRemoteFile(SaveFileName, RemoteFileurl)
						s_Content = Replace(s_Content,RemoteFileurl,SaveFileName)
					Next
					eWebEditor_ReplaceRemoteUrl = s_Content
				End Function
				
				'================================================
				'作  用:保存远程的文件到本地
				'参  数:LocalFileName ------ 本地文件名
				'		 RemoteFileUrl ------ 远程文件URL
				'返回值:True  ----成功
				'        False ----失败
				'================================================
				Sub eWebEditor_SaveRemoteFile(s_LocalFileName,s_RemoteFileUrl)
					Dim Ads, Retrieval, GetRemoteData
					On Error Resume Next
					Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
					With Retrieval
						.Open "Get", s_RemoteFileUrl, False, "", ""
						.Send
						GetRemoteData = .ResponseBody
					End With
					Set Retrieval = Nothing
					Set Ads = Server.CreateObject("Adodb.Stream")
					With Ads
						.Type = 1
						.Open
						.Write GetRemoteData
						.SaveToFile Server.MapPath(s_LocalFileName), 2
						.Cancel()
						.Close()
					End With
					Set Ads=nothing
				End Sub
				
				'================================================
				'作  用:检查组件是否已经安装
				'参  数:strClassString ----组件名
				'返回值:True  ----已经安装
				'        False ----没有安装
				'================================================
				Function eWebEditor_IsObjInstalled(s_ClassString)
					On Error Resume Next
					eWebEditor_IsObjInstalled = False
					Err = 0
					Dim xTestObj
					Set xTestObj = Server.CreateObject(s_ClassString)
					If 0 = Err Then eWebEditor_IsObjInstalled = True
					Set xTestObj = Nothing
					Err = 0
				End Function
				%>			

相关资源