中国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