中国DOS联盟

::再丑陋的衣服穿起来也保暖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