中国DOS联盟

怎样改进下面代码，能选中多了.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= "+://+"

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 ]

我在线等，大家帮帮我，我想处理收藏夹
，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，

[ Last edited by kioskboy on 2008-4-16 at 06:42 PM ]

代码有问题……（没有语法错误）


建议看看文本操作……
不知道URL用FSO好操作不……为什么要用流~

管理收藏夹用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= "+://+"
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 "网址列表已经生成！",,"成功"

zh15真的好谢谢你
能不能把<a href="string">的后面改成网页快捷方式url文件的名字
也就是说链接的文字不是网址
麻烦帮忙改下，不然网址太多我不好找

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 = "+://+"
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的也写了个连接……

唉，这样如果有的有ico的也写了个连接…
哪位大侠改改吧