asp版 起点中文小说下载器
作者:admin 日期:2009-4-23 15:25:2
<%
Server.ScriptTimeOut =999999
public Function WritFile(ByVal byt, ByVal fileName)
on error resume next
Dim objAso:set objAso=server.createobject("adodb.Stream")
objAso.Type = 1
objAso.Mode = 3
objAso.Open
objAso.Position = 0
objAso.Write byt
objAso.SaveToFile fileName, 2
objAso.Close
Set objAso = Nothing
WritFile = True
End Function
Public Function Download(ByVal URL, ByVal savePath)
On Error Resume Next
Dim ResBody, sStr, vPath, fileName, vErr
vErr = True
vPath = Replace(savePath, "/", "\")
If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
sPos = InStrRev(URL, "/") + 1
sStr = Mid(URL, sPos)
Set Http = Server.CreateObject("MICROSOFT.XMLHTTP")
Http.Open "GET", URL, False
Http.Send
If Http.Readystate = 4 Then
If Http.Status = 200 Then
ResBody = Http.responseBody
head = Http.getResponseHeader("content-disposition")
If head <> "" Then
startpos = InStr(head, "=") + 1
fileName = Mid(head, startpos)
ElseIf InStr(sStr, ".") > 0 And InStr(sStr, "?") <= 0 Then
fileName = sStr
Else
fileName = Getname() & ".cfm"
End If
If WritFile(ResBody, vPath & fileName) Then vErr = False
End If
End If
Download = Not vErr
End Function
public Function Getname()
on error resume next
Dim y,m,d,h,mm,S, r
Randomize
y = Year(Now)
m = Month(Now): If m < 10 Then m = "0" & m
d = Day(Now): If d < 10 Then d = "0" & d
h = Hour(Now): If h < 10 Then h = "0" & h
mm = Minute(Now): If mm < 10 Then mm = "0" & mm
S = Second(Now): If S < 10 Then S = "0" & S
r = 0
r = CInt(Rnd() * 1000)
If r < 10 Then r = "00" & r
If r < 100 And r >= 10 Then r = "0" & r
Getname = y & m & d & h & mm & S & r
End Function
x=Trim(Request.Form("x"))
y=Trim(Request.Form("y"))
if x<>"" and y<>"" then
for i = x to y
call download("http://download.qidian.com/chm/"&i&".chm",server.mappath("."))
next
else
%>
<form action="" method="post">
<input name="x" type="text" value="第一个书号" />
<input name="y" type="text" value="第二个书号" />
<input name="" type="submit" value="下载">
</form>
<%end if%>
使用方式,保存为asp文件。运行之 填写起始和结束书号确定即可。
已知问题,1.每次下载不要超过1000本
后续版本,将解决规定大小问题[本版本为adodb.stream] 如需要fso版本请点击这里
上一篇
下一篇
Tags: