标题: 网页收藏，划整为零 [打印本页]
作者: kioskboy 时间: 2008-4-15 15:33 标题: 网页收藏，划整为零
怎样改进下面代码，能选中多了.URL文件，拖到上面后
网页地址链接都写到 当前目录的sc.url中[ Last edited by kioskboy on 2008-4-15 at 05:52 PM ]
On Error Resume Next
Dim p,s,re
If Wscript.Arguments.Count=0 Then
Msgbox "请把网页拖到本程序的图标上！",,"提示"
Wscript.Quit
End If
For i= 0 to Wscript.Arguments.Count - 1
p=Wscript.Arguments(i)
With CreateObject("Adodb.Stream")
.Type=2
.Charset="GB2312"
.Open
.LoadFromFile=p
s=.ReadText
Set re =New RegExp
re.Pattern= "[A-z]+://[^""<>()\s']+"
re.Global = True
If Not re.Test(s) Then
Msgbox "该网页文件中未出现网址！",,"提示"
Wscript.Quit
End If
Set Matches = re.Execute(s)
s=""
For Each Match In Matches
s=s & "<a href=""" & Match.Value & """>" & Match.Value & "<p>"
Next
re.Pattern= "&\w+;?|\W{5,}"
s=re.Replace(s,"")
.Position=0
.setEOS
.WriteText s
.SaveToFile p & "'s URLs.html",2
.Close
End With
Next
Msgbox "网址列表已经生成！",,"成功"作者: kioskboy 时间: 2008-4-16 18:41
我在线等，大家帮帮我，我想处理收藏夹
，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，
[ Last edited by kioskboy on 2008-4-16 at 06:42 PM ]
作者: slore 时间: 2008-4-16 21:15
代码有问题……（没有语法错误）
建议看看文本操作……
不知道URL用FSO好操作不……为什么要用流~
作者: zh159 时间: 2008-4-16 21:17
管理收藏夹用IE自己的导入导出更方便
稍加修改
On Error Resume Next Dim p,s,re,fso,str Set objFSO = CreateObject("Scripting.FileSystemObject") If Wscript.Arguments.Count=0 Then Msgbox "请把网页拖到本程序的图标上！",,"提示" Wscript.Quit End If For i= 0 to Wscript.Arguments.Count - 1 p=Wscript.Arguments(i) With CreateObject("Adodb.Stream") .Type=2 .Charset="GB2312" .Open .LoadFromFile=p s=.ReadText Set re =New RegExp re.Pattern= "[A-z]+://[^""<>()\s']+" re.Global = True If Not re.Test(s) Then Msgbox "该网页文件中未出现网址！",,"提示" Wscript.Quit End If Set Matches = re.Execute(s) s="" For Each Match In Matches s=s & "<a href=""" & Match.Value & """>" & Match.Value & "<p>" Next str=str&s re.Pattern= "&\w+;?|\W{5,}" str=re.Replace(str,"") .Position=0 .setEOS .WriteText str .SaveToFile objFSO.GetParentFolderName(Wscript.Arguments(0)) & "\list URLs.html",2 .Close End With Next Msgbox "网址列表已经生成！",,"成功"
作者: kioskboy 时间: 2008-4-16 22:28
zh15真的好谢谢你
能不能把<a href="string">的后面改成网页快捷方式url文件的名字
也就是说链接的文字不是网址
麻烦帮忙改下，不然网址太多我不好找
作者: slore 时间: 2008-4-16 23:45
on Error Resume Next
Dim p,s,re,fso,str
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Wscript.Arguments.Count = 0 Then
MsgBox "请把网页拖到本程序的图标上！",,"提示"
Wscript.Quit
End If
For i = 0 To Wscript.Arguments.Count - 1
p = Wscript.Arguments(i)
With CreateObject("Adodb.Stream")
.Type = 2
.Charset = "GB2312"
.Open
.LoadFromFile = p
s = .ReadText
Set re = New RegExp
re.Pattern = "[A-z]+://[^""<>()\s']+"
re.Global = True
If Not re.Test(s) Then
MsgBox "该网页文件中未出现网址！",,"提示"
Wscript.Quit
End If
Set Matches = re.Execute(s)
s = ""
For Each Match In Matches
s = s & "<a href=""" & Match.Value & """>" & objFSO.GetBaseName(p) & "<p>"
Next
str = str & s
're.Pattern= "&\w+;?|\W{5,}"
'str=re.Replace(str,"")
.Position = 0
.setEOS
.WriteText str
.SaveToFile objFSO.GetParentFolderName(Wscript.Arguments(0)) & "\list URLs.html",2
.Close
End With
Next
MsgBox "网址列表已经生成！",,"成功"
为什么不直接读URL，你这样如果有的有ico的也写了个连接……
作者: yywd 时间: 2010-6-7 14:14
唉，这样如果有的有ico的也写了个连接…
哪位大侠改改吧