一个带采集远程文章内容,保存图片,生成文件等完整的采集功能

2019-01-13 08:00:14丽君

'==================================================
'函数名:DelDir
'作 用:创建文件夹
'参 数:foldername ------ 文件夹名
'==================================================
Function DelDir(byval foldername)
dim fso
Set fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
If fso.FolderExists(Server.MapPath(foldername)) Then '判断文件夹是否存在
fso.DeleteFolder (Server.MapPath(foldername)) '删除文件夹
End If
Set fso = nothing
End Function

'**************************************************
'函数名:IsObjInstalled
'作 用:检查组件是否已经安装
'参 数:strClassString ----组件名
'返回值:True ----已经安装
' False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function

'**************************************************
'函数名:strLength
'作 用:求字符串长度。汉字算两个字符,英文算一个字符。
'参 数:str ----要求长度的字符串
'返回值:字符串长度
'**************************************************
function strLength(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE = (len("中国")=2)
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function


'****************************************************
'函数名:CreateMultiFolder
'作 用:创建多级目录,可以创建不存在的根目录
'参 数:要创建的目录名称,可以是多级
'返回逻辑值:True成功,False失败
'创建目录的根目录从当前目录开始
'****************************************************
Function CreateMultiFolder(ByVal CFolder)
Dim objFSO,PhCreateFolder,CreateFolderArray,CreateFolder
Dim i,ii,CreateFolderSub,PhCreateFolderSub,BlInfo
BlInfo = False
CreateFolder = CFolder
On Error Resume Next
Set objFSO = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
If Err Then
Err.Clear()
Exit Function
End If
CreateFolder = Replace(CreateFolder,"","/")
If Left(CreateFolder,1)="/" Then
'CreateFolder = Right(CreateFolder,Len(CreateFolder)-1)
End If
If Right(CreateFolder,1)="/" Then
CreateFolder = Left(CreateFolder,Len(CreateFolder)-1)
End If
CreateFolderArray = Split(CreateFolder,"/")
For i = 0 to UBound(CreateFolderArray)
CreateFolderSub = ""
For ii = 0 to i
CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"
Next
PhCreateFolderSub = Server.MapPath(CreateFolderSub)