|
- 小学一年级
- 413632
- 22
- 0
- 4 朵
- 41 个
- 6 个
- 500
- 2010-05-07
|
1#
t
T
发表于 2025-01-14 10:37
|
|只看楼主
- Rem 人民日报下载（仅支持今年1月5日以后）
- Dim n,y,r,b //(年月日版)
- n = InputBox("请输入年份：" & chr(10) & chr(10) & chr(10) &"（已默认当前年度）","年度输入",Year(Now))
- y = InputBox("请输入月份：" & chr(10) & chr(10) & chr(10) &"（已默认当前月份）","月份输入",Month(Now))
- r = InputBox("请输入日期：" & chr(10) & chr(10) & chr(10) &"（已默认当前日期）","日期输入",Day(Now))
- If y < 10 Then
- y = "0" & y
- ElseIf y >= 10 Then
- y=""&y
- End If
- If r < 10 Then
- r = "0" & r
- ElseIf r >= 10 Then
- r=""&r
- End If
- 是否已下 = Plugin.File.IsFileExit("D:\book\人民日报\人民日报 " & n & "年\" & y & "\" & n & y & r & ".pdf")
- If 是否已下 = 0 Then
- Else
- MessageBox "输入的日期已经下载，请指定其他日期。"
- Goto 人民日报下载
- End If
- Call Plugin.File.CreateFolder("D:\book\人民日报\人民日报 " & n & "年\" & y)
- Call Plugin.File.CreateFolder("D:\book\人民日报\人民日报 " & n & "年\" & y & r)
- Dim 月份，临时文件夹,临时存放
- 月份 = "D:\book\人民日报\人民日报 " & n & "年\" & y
- 临时文件夹 = "D:\book\人民日报\人民日报 " & n & "年\" & y & r
- 临时存放 = "D:\book\人民日报\人民日报 " & n & "年\" & y & r & "\"
- b = 0
- Rem 开始
- While b >= 0
- b = b + 1
- If b < 10 Then
- b="0"&b
- ElseIf b >= 10 Then
- b=""&b
- End If
- Goto 下载
- Wend
- Rem 下载
- Dim 报纸版面
- 报纸版面 = Lib.网络.获得网页源文件("http://paper.people.com.cn/rmrb/pc/layout/" + n + y + "/" + r + "/node_" + b + ".html")
- Function RmrbMid(报纸版面, 左边内容, 右边内容)
- Dim 左边位置, 右边位置, 起始位置, 截取内容, 截取长度
- 左边位置 = InStr(报纸版面, 左边内容)
- If 左边位置 > 0 Then
- 起始位置 = 左边位置 + Len(左边内容)
- If 右边内容 = "" Then
- 截取长度 = Len(报纸版面)
- Else
- 右边位置 = InStr(起始位置, 报纸版面, 右边内容)
- If 右边位置 > 0 Then
- 截取长度 = 右边位置 - 起始位置
- 截取内容 = mid(报纸版面, 起始位置, 截取长度)
- End If
- End If
- End If
- RmrbMid = 截取内容
- End Function
- Dim 初始链接, lj, 真实地址, 保存位置, 信息反馈
- 初始链接 = RmrbMid(报纸版面, "right btn", "download")
- lj = RmrbMid(初始链接, "attachement", "pdf")
- 真实地址 = "http://paper.people.com.cn/rmrb/pc/attachement" + lj + "pdf"
- 保存位置 = 临时存放 + b + ".pdf"
- Call Plugin.Msg.ShowScrTXT(1000, 200, 1400, 250, "正在下载" & n & "年" & y & "月" & r & "日第 " & b & " 版。", "0000FF")
- 信息反馈 = Plugin.dm.DownloadFile(真实地址, 保存位置, 3000)
- If 信息反馈 = 1 Then
- Goto 开始
- Else
- Call Plugin.File.DeleteFolder(保存位置) //删除最后一个空文件
- Call Plugin.Msg.ShowScrTXT(1000, 260, 1400, 310, n & "年" & y & "月" & r & "日共 " & b - 1 & " 版全部下载。", "0000FF")
- Delay 1000
- Goto 合并
- End If
- Rem 合并
- Dim folderPath, outputFile //定义文件夹路径和输出文件路径
- folderPath = 临时存放
- outputFile = 月份 & "\" & n & y & r & ".pdf"
- Dim fso, folder, fileCollection //创建FileSystemObject对象
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set folder = fso.GetFolder(folderPath)
- Set fileCollection = folder.Files
- Dim pdftkCmd //初始化pdftkCmd字符串
- pdftkCmd = "D:\book\人民日报\工具\plugin\pdftk " //指定pdftk的位置，仅需要pdftk.exe和libiconv2.dll两个文件
- For Each file In fileCollection //遍历文件夹中的文件，构建pdftkCmd字符串
- If LCase(fso.GetExtensionName(file.Path)) = "pdf" Then
- pdftkCmd = pdftkCmd & """" & file.Path & """ "
- End If
- Next
- pdftkCmd = pdftkCmd & "cat output """ & outputFile & """"
- RunApp pdftkCmd
- //如果合并任务完成，则删除临时存放文件夹
- i = 0
- Rem 合并检查
- While i >= 0
- i = i + 1
- 合并结果=Plugin.dm.IsFileExist(outputFile)
- If 合并结果 = 1 Then
- Delay 500
- Set fsoa = CreateObject("Scripting.FileSystemObject")
- fsoa.DeleteFolder 临时文件夹
- Goto 人民日报下载
- Else
- Delay 1000
- Goto 合并检查
- End If
- Wend
|
闽公网安备 35010002000112号