中国DOS联盟论坛 - Powered by Discuz! Board

标题: 网页收藏，划整为零 [打印本页]

作者: kioskboy 时间: 2008-4-15 15:33 标题: 网页收藏，划整为零

怎样改进下面代码，能选中多了.URL文件，拖到上面后
网页地址链接都写到当前目录的sc.url中

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 "网址列表已经生成！",,"成功"

[ Last edited by kioskboy on 2008-4-15 at 05:52 PM ]

作者: 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自己的导入导出更方便

稍加修改

Quote:

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的也写了个连接…
哪位大侠改改吧