sig13

我用vbs写了一个很傻的，但是没有用到第三方。主要是练习vbs的。

增加了两处错误处理，不是那么容易死了。

'比较傻的 Load http://www.yi-look.com/ 文本小说的脚本，代码是根据该网页特征写的
'即，该脚本只能用于 yilook 上的 Load
'必须进入到要 Load 的小说的首页，复制下 URL，作为参数运行该脚本，用如下命令
'cscript //Nologo //E:vbscript gyilook.vbs http://www.yi-look.com/art_??_??.html
'会在脚本当前目录下生成一个小说名的目录，里面按照 "第??节.txt" 保存文件
Option Explicit

Dim regExUrl
Set regExUrl = new RegExp
regExUrl.Pattern= "http://www.yi-look.com/art_\d+_\d+.html"

If regExUrl.Test(WScript.Arguments(0)) = False Then
	Wscript.echo "Maybe Not yi-look's URL?"
	WScript.Quit
End If

Set regExUrl = Nothing

Dim loadPage
Dim oDom

Do
	Wscript.echo "Loading the first page..."
	set oDom = WScript.GetObject(WScript.Arguments(0))
	loadPage = WaitLoading(oDom)
loop While loadPage = False

Dim dirName

Dim e
For each e in oDom.all
	If e.tagName = "TITLE" Then
		If Right(e.outerText, 2) = "易读"  Then
			dirName = Left(e.outerText, (Len(e.outerText) - 3))
			Exit For
		Else
			Wscript.echo "Maybe Not real yi-look's URL?"
			WScript.Quit
		End If
	End If
Next

Dim fso

Set fso = CreateObject("Scripting.FileSystemObject")
Do While fso.FolderExists(dirName)   
	dirName = dirName & "0"
Loop

fso.CreateFolder(dirName)   
Set fso = Nothing

Dim regEx
Set regEx = new RegExp
regEx.Pattern= "第\d+节"

Dim lnk
For each lnk in oDom.links
	If (regEx.Test(lnk.outerText)) Then
		Dim oDomX

		Do
			Wscript.echo "Loading " & lnk.outerText & "... " & lnk.href
			On Error Resume Next
			Set oDomX = WScript.GetObject(lnk.href)
			If Err.Number = 0 Then
				loadPage = WaitLoading(oDomX)
			Else
				Wscript.echo "ERROR #" & CStr(Err.Number) & " " & Err.Description
				Wscript.echo "Try again!!!"
				Err.clear
				loadPage = False
			End If
		loop While loadPage = False

		Dim fn
		fn = dirName & "\" & lnk.outerText & ".txt"
		Call WriteTextFile(fn, oDomX.body.outerText)
		Set oDomX = Nothing
	End If
Next

Set oDom = Nothing
Set regEx = Nothing

Function WaitLoading(DomObj)
	Const TickOut = 60
	Dim tick
	tick = 0
	
	Do until DomObj.readyState = "complete"
		tick = tick + 1
		
		If tick > TickOut Then
			WScript.echo "Timed out! Load failed... Try again! "
			Exit Do
		End If

		WScript.sleep 500
	Loop
	
	WaitLoading = (tick <= TickOut)
End Function

Sub WriteTextFile(FileName, TextString)
	Const ForReading = 1, ForWriting = 2, ForAppending = 8
	Dim fso, f
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set f = fso.OpenTextFile(FileName, ForWriting, True, -1)
	f.Write TextString
	f.Close
	Set fso = Nothing
	Set f = Nothing
End Sub 
复制代码

[ 本帖最后由 sig13 于 2010-4-29 18:30 编辑 ]

sig13

我才调试完，yi-look就又被关了，什么世道？
不是我一个人连不上吧？
---
居然又开了，之前的脚本在load页面失败之后就挂了，增加了纠错功能，现在应该没问题了

[ 本帖最后由 sig13 于 2010-4-29 15:40 编辑 ]