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

标题: 删除网址死链接的问题 (已结) [打印本页]

作者: bluewaterx 时间: 2008-9-23 10:35 标题: 删除网址死链接的问题 (已结)

完整代码在4楼:

-----------------------------------------------------
我想做个自动清理收藏夹里是死链接的无效网址

有个html文件中用了vbs,实现了这个功能

怎么应用在bat里？有兴趣的帮个忙，vbs都忘的差不多了 -.=

<html><body>
<input type="text" id="jnkcInput" value="http://www.csdn.net" size="50"><button id="chk">检测</button><div id="jnkc_show"></div>
<SCRIPT LANGUAGE="VBScript">
Dim i,jnkcUrl,jnkcHTML,jnkcStatus,jnkcServer
Function chk_onClick()
jnkcUrl = jnkcInput.value
Call GetDetail
i = i+1
jnkc_show.innerHTML = "<pre>" & jnkcStatus & "</pre>" & jnkc_show.innerHTML
End Function
Dim jnkcXMLHTTP
Sub GetDetail
Set jnkcXMLHTTP = CreateObject("Microsoft.XMLHTTP")
jnkcXMLHTTP.OnReadyStateChange = GetRef("GetStatus")
jnkcXMLHTTP.Open "GET", jnkcUrl, False
On Error Resume Next
jnkcXMLHTTP.Send
Set jnkcXMLHTTP = Nothing
End Sub
Sub GetStatus
If jnkcXMLHTTP.ReadyState <> 4 Then Exit Sub
If jnkcXMLHTTP.Status = 404 Then
jnkcStatus = "× " & jnkcInput.value
ElseIf jnkcXMLHTTP.Status < 200 Then
jnkcStatus = "≠ " & jnkcInput.value
ElseIf jnkcXMLHTTP.Status < 300 Then
jnkcStatus = "√ " & jnkcInput.value
ElseIf jnkcXMLHTTP.Status < 400 Then
jnkcStatus = "∠ " & jnkcInput.value
ElseIf jnkcXMLHTTP.Status < 500 Then
jnkcStatus = "≠ " & jnkcInput.value
ElseIf jnkcXMLHTTP.Status < 600 Then
jnkcStatus = "〓 " & jnkcInput.value
Else
jnkcStatus = "× " & jnkcInput.value
End If
If jnkcXMLHTTP.Status < 600 Then Call GetServer
End Sub
Sub GetServer
jnkcServer = jnkcXMLHTTP.GetResponseHeader("Server")
End Sub
</SCRIPT>
</body></html>

[ Last edited by bluewaterx on 2008-9-23 at 07:49 PM ]

作者: bluewaterx 时间: 2008-9-23 14:49
等了这么久也没人回应，哎，自己现学了一下vbs
改了代码,原型出来了
@echo off
Echo Dim strUrl,strST>ps.vbs
Echo strUrl="http://www.bfdfdfsaidu.com">>ps.vbs
Echo Set objXH = CreateObject("Microsoft.XMLHTTP")>>ps.vbs
Echo objXH.OnReadyStateChange = GetRef("GetStatus")>>ps.vbs
Echo objXH.Open "GET", strUrl, False>>ps.vbs
Echo On Error Resume Next>>ps.vbs
Echo objXH.Send>>ps.vbs
Echo Set objXH = Nothing>>ps.vbs
Echo Wscript.echo strST>>ps.vbs
Echo Sub GetStatus>>ps.vbs
Echo If objXH.ReadyState ^<^> 4 Then Exit Sub>>ps.vbs
Echo If objXH.Status = 404 Then>>ps.vbs
Echo strST = "× " ^& strUrl>>ps.vbs
Echo ElseIf objXH.Status ^< 200 Then>>ps.vbs
Echo strST = "≠ " ^& strUrl>>ps.vbs
Echo ElseIf objXH.Status ^< 300 Then>>ps.vbs
Echo strST = "√ " ^& strUrl>>ps.vbs
Echo ElseIf objXH.Status ^< 400 Then>>ps.vbs
Echo strST = "∠ " ^& strUrl>>ps.vbs
Echo ElseIf objXH.Status ^< 500 Then>>ps.vbs
Echo strST = "≠ " ^& strUrl>>ps.vbs
Echo ElseIf objXH.Status ^< 600 Then>>ps.vbs
Echo strST = "〓 " ^& strUrl>>ps.vbs
Echo Else>>ps.vbs
Echo strST = "× " ^& strUrl>>ps.vbs
Echo End If>>ps.vbs
Echo End Sub>>ps.vbs
cscript //nologo ps.vbs
del /q ps.vbs >nul 2>nul
pause

作者: bluewaterx 时间: 2008-9-23 16:57
终于做完了,嘿,克服困难就是胜利
执行结果:

请输入要检测网址的目录:D:\收藏夹
优多比网--股票学习资料.url:    ×
得必者.url:    √
股票书籍.url: √
宽乐星空套餐.url:    √
话费查询.url: ×
中国证券报·网络版·股票.url: √
短线出击 - °Ａｘ丶 - 网易网志.url:    √
q表情qq搞笑表情 QQ自定义表情qq聊天表情-中国移不动.url: √
系统找不到指定的文件。
深圳市飞行迅达科技有限公司.url: ×
tockQ 国际股市指数行情.url: √
时尚_Q吧.url: √
火星语官方网站－火星文输入法、火星文字输入法、繁体字、异体字、简体字、QQ个性签名
在线转换---火星语官方网站.url:  √
华展投资咨询有限公司.url:    √
深圳人才-深圳人才网.url:       √
绿色软件 - 未来软件园 - 绿色软件下载站.url:    √
深圳人才网 -- 个人求职.url:    √
系统找不到指定的文件。
老红牛股海搏击 - 老红牛4706 - 和讯网志.url:    √
深圳地图_深圳市地图_深圳电子地图_深圳本地宝.url:       √
中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛.url: √
OL壁纸 desk.zol.com.cn.url: √
新e时代建站网--网上兼职工作创业项目自助建站网上商城加盟代理投资项目网络兼职什么
生意最赚钱家庭兼职办公室兼职商品代销网站源码电脑兼职打字录入.url:    √
发展联盟娱乐宽带电视直播-http--www.fzlm.com - 翡翠台本港台凤凰卫视广东卫视华娱卫
视星空卫视在线直播.url: √
宏碁中国--驱动程序--整机.url: √
我爱电子书-电脑教程-全国最大的免费电子书下载基地.url: √
OS批处理 & 脚本技术（批处理室） - 中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛.u
:    √
请按任意键继续. . .

作者: bluewaterx 时间: 2008-9-23 17:44
@echo off
setlocal enabledelayedexpansion
set cInput=&set strST=
set /p cInput=托入要检测无效网址的目录于此:
if not defined cInput Set cInput=%userprofile%\Favori~1
for /f "delims=" %%i in ('dir /a-d /b "!cInput!\*.url"') do (
for /f "delims=" %%j in ('type "!cInput!\%%i"') do (
set tmpStr=%%j
if /i "!tmpStr:~0,3!"=="URL" (
      <nul set/p=%%i:
      call :subSendUrl "!tmpStr:~4!"
)
)
)
del /q ps.vbs >nul 2>nul
pause&exit
:subSendUrl
Echo Dim strUrl,strST>ps.vbs
Echo strUrl=%1>>ps.vbs
Echo Set objXH = CreateObject("Microsoft.XMLHTTP")>>ps.vbs
Echo objXH.OnReadyStateChange = GetRef("GetStatus")>>ps.vbs
Echo objXH.Open "GET", strUrl, False>>ps.vbs
Echo On Error Resume Next>>ps.vbs
Echo objXH.Send>>ps.vbs
Echo Set objXH = Nothing>>ps.vbs
Echo Wscript.echo strST>>ps.vbs
Echo Sub GetStatus>>ps.vbs
Echo If objXH.ReadyState ^<^> 4 Then Exit Sub>>ps.vbs
Echo If objXH.Status = 404  Then>>ps.vbs
Echo strST = "×">>ps.vbs
Echo ElseIf objXH.Status ^< 200 Then>>ps.vbs
Echo strST = "≠">>ps.vbs
Echo ElseIf objXH.Status ^< 300 Then>>ps.vbs
Echo strST = "√">>ps.vbs
Echo ElseIf objXH.Status ^< 400 Then>>ps.vbs
Echo strST = "∠">>ps.vbs
Echo ElseIf objXH.Status ^< 500 Then>>ps.vbs
Echo strST = "≠">>ps.vbs
Echo ElseIf objXH.Status ^< 600 Then>>ps.vbs
Echo strST = "〓">>ps.vbs
Echo Else>>ps.vbs
Echo strST = "×">>ps.vbs
Echo End If>>ps.vbs
Echo End Sub>>ps.vbs
cscript //nologo ps.vbs
goto :eof