|
kioskboy
初级用户
积分 153
发帖 103
注册 2008-3-27
状态 离线
|
『楼 主』:
网页收藏，划整为零
怎样改进下面代码，能选中多了.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 ]
|
|
 2008-4-15 15:33 |
|
|
kioskboy
初级用户
积分 153
发帖 103
注册 2008-3-27
状态 离线
|
『第
2 楼』:
我在线等，大家帮帮我，我想处理收藏夹
，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，，
[ Last edited by kioskboy on 2008-4-16 at 06:42 PM ]
|
|
|
2008-4-16 18:41 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
3 楼』:
代码有问题……（没有语法错误）
建议看看文本操作……
不知道URL用FSO好操作不……为什么要用流~
|
|
|
2008-4-16 21:15 |
|
|
zh159
金牌会员
积分 3687
发帖 1467
注册 2005-8-8
状态 离线
|
『第
4 楼』:
管理收藏夹用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 "网址列表已经生成！",,"成功"
|
|
|
|
2008-4-16 21:17 |
|
|
kioskboy
初级用户
积分 153
发帖 103
注册 2008-3-27
状态 离线
|
『第
5 楼』:
zh15真的好谢谢你
能不能把<a href="string">的后面改成网页快捷方式url文件的名字
也就是说链接的文字不是网址
麻烦帮忙改下，不然网址太多我不好找
|
|
|
2008-4-16 22:28 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
6 楼』:
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的也写了个连接……
|
|
|
2008-4-16 23:45 |
|
|
yywd
中级用户
积分 358
发帖 130
注册 2005-11-12
状态 离线
|
『第
7 楼』:
唉，这样如果有的有ico的也写了个连接…
哪位大侠改改吧
|
|
|
2010-6-7 14:14 |
|
|
