newasp中下载类

　　复制代码 代码如下:
<%
================================================
函数名：SaveRemoteFile
作用：保存远程文件到本地
参数：strFileName----保存文件的名称
strRemoteUrl----远程文件URL
返回值：布尔值True/False
================================================
FunctionSaveRemoteFile(ByValstrFileName,ByValstrRemoteUrl)
DimoStream,Retrieval,GetRemoteData

SaveRemoteFile=False
OnErrorResumeNext
SetRetrieval=Server.CreateObject(Microsoft.XMLHTTP)
Retrieval.OpenGET,strRemoteUrl,False,,
Retrieval.Send
IfRetrieval.readyState<>4ThenExitFunction
IfRetrieval.Status>300ThenExitFunction
GetRemoteData=Retrieval.ResponseBody
SetRetrieval=Nothing

IfLenB(GetRemoteData)>100Then
SetoStream=Server.CreateObject(Adodb.Stream)
oStream.Type=1
oStream.Mode=3
oStream.Open
oStream.WriteGetRemoteData
oStream.SaveToFileServer.MapPath(strFileName),2
oStream.Cancel
oStream.Close
SetoStream=Nothing
Else
ExitFunction
EndIf

IfErr.Number=0Then
SaveRemoteFile=True
Else
Err.Clear
EndIf
EndFunction
%>

复制代码 代码如下:
<%
ClassDownload_Cls
PrivatesUploadDir
PrivatenAllowSize
PrivatesAllowExt
PrivatesOriginalFileName
PrivatesSaveFileName
PrivatesPathFileName

PublicPropertyGetRemoteFileName()
RemoteFileName=sOriginalFileName
EndProperty

PublicPropertyGetLocalFileName()
LocalFileName=sSaveFileName
EndProperty

PublicPropertyGetLocalFilePath()
LocalFilePath=sPathFileName
EndProperty

PublicPropertyLetRemoteDir(ByValstrDir)
sUploadDir=strDir
EndProperty

PublicPropertyLetAllowMaxSize(ByValintSize)
nAllowSize=intSize
EndProperty

PublicPropertyLetAllowExtName(ByValstrExt)
sAllowExt=strExt
EndProperty

PrivateSubClass_Initialize()
OnErrorResumeNext
Script_Object=Scripting.FileSystemObject
sUploadDir=UploadFile/
nAllowSize=500
sAllowExt=gifjpgpngbmp
EndSub

PublicFunctionChangeRemote(sHTML)
OnErrorResumeNext
Dims_Content
s_Content=sHTML
OnErrorResumeNext
Dimre,s,RemoteFileUrl,SaveFileName,SaveFileType
Setre=NewRegExp
re.IgnoreCase=True
re.Global=True
re.Pattern=((httphttpsftprtspmms):(\/\/\\\\){1}(([A-Za-z0-9_-])+[.]){1,}(netcomcnorgcctv[0-9]{1,3})(\S*\/)((\S)+[.]{1}(&sAllowExt&)))
Sets=re.Execute(s_Content)
Dima_RemoteUrl(),n,i,bRepeat
n=0
转入无重复数据
ForEachRemoteFileUrlIns
Ifn=0Then
n=n+1
ReDima_RemoteUrl(n)
a_RemoteUrl(n)=RemoteFileUrl
Else
bRepeat=False
Fori=1ToUBound(a_RemoteUrl)
IfUCase(RemoteFileUrl)=UCase(a_RemoteUrl(i))Then
bRepeat=True
ExitFor
EndIf
Next
IfbRepeat=FalseThen
n=n+1
ReDimPreservea_RemoteUrl(n)
a_RemoteUrl(n)=RemoteFileUrl
EndIf
EndIf
Next
开始替换操作
DimnFileNum,sContentPath,strFilePath
sContentPath=RelativePath2RootPath(sUploadDir)
nFileNum=0
Fori=1Ton
SaveFileType=Mid(a_RemoteUrl(i),InStrRev(a_RemoteUrl(i),.)+1)
SaveFileName=GetRndFileName(SaveFileType)
strFilePath=sUploadDir&SaveFileName
IfSaveRemoteFile(strFilePath,a_RemoteUrl(i))=TrueThen
nFileNum=nFileNum+1
IfnFileNum>0Then
sOriginalFileName=sOriginalFileName&
sSaveFileName=sSaveFileName&
sPathFileName=sPathFileName&
EndIf
sOriginalFileName=sOriginalFileName&Mid(a_RemoteUrl(i),InStrRev(a_RemoteUrl(i),/)+1)
sSaveFileName=sSaveFileName&SaveFileName
sPathFileName=sPathFileName&sContentPath&SaveFileName
s_Content=Replace(s_Content,a_RemoteUrl(i),sContentPath&SaveFileName,1,-1,1)
EndIf
Next

ChangeRemote=s_Content
EndFunction

PublicFunctionRelativePath2RootPath(url)
这个主要是实现../转换为实际路径
DimsTempUrl
sTempUrl=url
IfLeft(sTempUrl,1)=/Then
RelativePath2RootPath=sTempUrl
ExitFunction
EndIf

DimsWebEditorPath
sWebEditorPath=Request.ServerVariables(SCRIPT_NAME)
sWebEditorPath=Left(sWebEditorPath,InStrRev(sWebEditorPath,/)-1)
DoWhileLeft(sTempUrl,3)=../
sTempUrl=Mid(sTempUrl,4)
sWebEditorPath=Left(sWebEditorPath,InStrRev(sWebEditorPath,/)-1)
Loop
RelativePath2RootPath=sWebEditorPath&/&sTempUrl
EndFunction

PublicFunctionGetRndFileName(sExt)
DimsRnd
Randomize
sRnd=Int(900*Rnd)+100
GetRndFileName=Year(Now)&Month(Now)&Day(Now)&Hour(Now)&Minute(Now)&Second(Now)&sRnd&.&sExt
EndFunction
EndClass
%>