::再丑陋的衣服穿起来也保暖21:59 2008-11-14
@echo off
setlocal enabledelayedexpansion
::动态标题效果,包含子程序ptloot,printtitle,runcommand
if "%1" equ "-title" call :PrintTitle "检 测 指 定 目 录 中 所 有 网 址 是 否 为 无 效 网 址 . . ."
start /b "NewThread" %0 -title
tasklist|findstr "\<cmd.exe\>">"%tmp%\t4.17"
:subMenu
del /q !tmp!\检测结果.txt >nul 2>nul
del /q !tmp!\待处理网址.txt >nul 2>nul
for /f "skip=4 delims=" %%i in ('reg query "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders" /v Favorites') do set favPath=%%i
set favPath=%favPath:~21%
cls&echo.&echo. 1.自动检索收藏夹 ( "%favPath%" 默认 )&echo.&echo. 2.检索其他目录&echo.&&set cInput=&set/p cInput= 请选择:
if not defined cInput call :subM1 & call :subUrlCheck 1
if %cInput% equ 1 call :subM1 & call :subUrlCheck 1
if %cInput% equ 2 call :subM2 & call :subUrlCheck 2
goto subMenu
:subM1
set varDr=%favPath%&cls&echo. Email:420751783@qq.com&set cInput=%favPath%&goto :eof
:subM2
cls&for /l %%i in (1,1,12) do echo.
set cInput=
set /p cInput= 托入目录至此:
if not defined cInput goto subMenu
set varDr=%cInput%
goto :eof
:subUrlCheck
for /l %%i in (1,1,40) do <nul set/p=\/& ping 127.1 -n 1 >nul 2>nul
echo/
if %1 equ 2 for /f "delims=" %%i in (!cInput!) do set cInput=%%~i
if not exist "!cInput!\*.url" goto :subMenu
for /f "delims=" %%i in ('dir /a-d /s /b "!cInput!\*.url"') do (
for /f "delims=" %%j in ('type "%%i"') do (
set tmpStr=%%j
if /i "!tmpStr:~0,3!"=="URL" (
<nul set/p=%%~nxi: wait...
<nul set/p=%%i: wait...>>!tmp!\检测结果.txt 2>nul
call :subSendUrl "!tmpStr:~4!")))
del /q !tmp!\ps.vbs >nul 2>nul
echo.&for /l %%i in (1,1,34) do <nul set/p=\& ping 127.1 -n 1 >nul 2>nul
<nul set/p=QQ:420751783
for /l %%i in (1,1,34) do <nul set/p=/& ping 127.1 -n 1 >nul 2>nul
for /f "delims=" %%i in (!tmp!\检测结果.txt) do (
set varUrl=%%i
if "!varUrl:~-6,1!"=="×" echo "!varUrl:~0,-18!">>!tmp!\待处理网址.txt)
if exist "!tmp!\待处理网址.txt" (
set cr=
set/p cr=是否删除无效网址链接(Y/N^)
if /i "!cr!"=="y" for /f "delims=" %%i in (!tmp!\待处理网址.txt) do del /s /q "!varDr!\%%~i")
echo\&pause&goto :eof
: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
<nul set/p=
cscript //nologo ps.vbs
cscript //nologo ps.vbs>>!tmp!\检测结果.txt
goto :eof
:RunCommand
set/p COMMAND=%cd%^>
if "%COMMAND%"=="" (
goto :RunCommand
) else (
if "%COMMAND%"=="exit" (
for /f "usebackq tokens=2" %%a in ("%tmp%\t4.17") do set t=%%a
del "%tmp%\t4.17"
call taskkill /f /pid %%t%% >nul))
call %COMMAND%
echo.
set "COMMAND="
goto :RunCommand
exit/b
:PrintTitle
set s'=%~1&set/a n'=0,t'=n'+1
:ptloop
call set o'=%%s':~%n'%,1%%&if "%o'%" equ "" goto :PrintTitle
call title %%s':~0,%t'%%%&set/a n'+=1,t'=n'+1&ping 127.1 -n 1 >nul&goto :ptloop
Last edited by bluewaterx on 2008-11-17 at 21:04 ]
