ぷりんときっずの無料プリントをよく利用させていただいている。フォントが丸文字のプリントもあったりするが，わざわざ教科書体で作り直してくださったものもあり，ありがたく活用させていただいている。
まとめてダウンロードしたいプリントも多いのだが，一括ダウンロードはできないようなので，専用のダウンローダーを作成してみる。
あまり負荷をかけるのもよくないとは思うが，かなり高速なレスポンスのサーバーのようなので，個人的にダウンローダーを作成して使う分には問題なさそうだと思っている。
まずは，１ページにまとめられているPDFのプリントをすべてダウンロードしてみる。
 | chromeでPDFのリンクを右クリック→検証で，デベロッパーツールでHTMLを確認すると，PDFのダウンロードページのPDFへのリンク部分は左のようになっている。
PDFファイルへのリンクは，id="topic"のdiv要素を検索し，その中のa要素を検索して取得することにする。
※id="easy"のdiv要素内に「簡単」レベルのプリントが，id="normal"のdiv要素内に「普通」レベルのプリントが，id="hard"のdiv要素内に「難しい」レベルのプリントが格納されている。
|
１つ１つのPDFファイルへのリンクは下のようなHTMLになっている。ファイル名からプリントを探しやすくするために，a要素内のp要素のInnerTextをファイル名として保存する。
プリントの分類をわかりやすくするために，ダウンロードしたPDFフィアルを格納するフォルダは，下のパンくずリストをフォルダ名にする。
 | パンくずリストは，id="pan-nav"のdiv要素を取得し，その中のspan要素のInnerTextから取得する。
|
下のコードをフォームのコードにコピー・貼り付けをすれば動作します。Option Explicit On
Option Strict On
Imports System.IO
Imports Microsoft.Win32
Public Class Form1
Private ToolStrip As New ToolStrip
Private WithEvents tsbDownload As New ToolStripButton With {.Text = "ダウンロード"}
Private StatusStrip As New StatusStrip
Private WithEvents tspProgress As New ToolStripProgressBar
Private tslStatus As New ToolStripLabel
Private WithEvents WebBrowser As New WebBrowser With {.Dock = DockStyle.Fill}
Private baseUrl As New Uri("https://print-kids.net/")
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Text = "ぷりんときっずダウンローダー"
Me.Size = New Size(1024, 678)
BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
Me.WebBrowser.ScriptErrorsSuppressed = True
Me.ToolStrip.Items.Add(tsbDownload)
Me.StatusStrip.Items.AddRange({tspProgress, tslStatus})
Me.Controls.AddRange({Me.ToolStrip, Me.WebBrowser, Me.StatusStrip})
Me.WebBrowser.Navigate(baseUrl)
End Sub
Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
BrowserEmulation.DeleteRenderingModeRegkey()
End Sub
Private Sub tsbDownload_Click(sender As Object, e As EventArgs) Handles tsbDownload.Click
downloadPdfs(Me.WebBrowser.Url)
End Sub
Private Sub downloadPdfs(url As Uri)
Dim tempWebBrowser As New WebBrowser
tempWebBrowser.ScriptErrorsSuppressed = True
AddHandler tempWebBrowser.DocumentCompleted, AddressOf WebBrowser_DocumentCompleted
tempWebBrowser.Navigate(url)
End Sub
Private Sub WebBrowser_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs)
Dim Browser As WebBrowser = DirectCast(sender, WebBrowser)
If e.Url.Equals(Browser.Url) Then
Dim pdfLinks = Browser.Document.GetElementById("topic").GetElementsByTagName("a").Cast(Of HtmlElement) _
.Select(Function(anchorTag) New With {.AnchorElement = anchorTag, .Uri = New Uri(anchorTag.GetAttribute("href"))}) _
.Where(Function(anchorTag) baseUrl.IsBaseOf(anchorTag.Uri) AndAlso Path.GetExtension(anchorTag.Uri.AbsoluteUri).ToLower = ".pdf") _
.Select(Function(anchorTag) New With {anchorTag.Uri, .Text = anchorTag.AnchorElement.GetElementsByTagName("p")(0).InnerText})
Dim downloadDir = Browser.Document.GetElementById("pan-nav").GetElementsByTagName("span").Cast(Of HtmlElement) _
.Select(Function(spanTag) spanTag.InnerText) _
.Aggregate(String.Empty, Function(result As String, title As String) Path.Combine(result, title))
downloadDir = Path.Combine(My.Computer.FileSystem.SpecialDirectories.Desktop, downloadDir)
If Not Directory.Exists(downloadDir) Then
My.Computer.FileSystem.CreateDirectory(Path.Combine(downloadDir))
End If
Dim Progress As Integer = 0
Me.tspProgress.Maximum = pdfLinks.Count
Me.tspProgress.Value = Progress
Me.tslStatus.Text = ""
Me.StatusStrip.Refresh()
For Each pdfLink In pdfLinks
Dim DownloadFileName As String = Path.Combine(downloadDir, pdfLink.Text.Replace(" ", "") & ".pdf")
Dim DownloadUrl As String = Path.GetFileName(pdfLink.Uri.AbsoluteUri)
Dim Status As String = " スキップ"
If Not File.Exists(DownloadFileName) Then
My.Computer.Network.DownloadFile(pdfLink.Uri, DownloadFileName)
Status = " ダウンロード中..."
End If
Me.tspProgress.Value = Progress
Me.tslStatus.Text = Progress + 1 & "/" & Me.tspProgress.Maximum & " " & DownloadUrl & Status
Me.StatusStrip.Refresh()
Progress += 1
Next
Me.tspProgress.Value = Me.tspProgress.Maximum
Me.tslStatus.Text = "ダウンロード完了"
Me.StatusStrip.Refresh()
Browser.Dispose()
End If
End Sub
End Class
Public Class BrowserEmulation
Public Enum Emulation
IE11Edge = 11001
IE11 = 11000
IE10Std = 10001
IE10 = 10000
IE9Std = 9999
IE9 = 9000
IE8Std = 8888
IE8 = 8000
IE7 = 7000
End Enum
Private Const FEATURE_BROWSER_EMULATION As String = "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION"
Public Shared Sub CreateRenderingModeRegkey(EmulationMode As Emulation)
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
Regkey.SetValue(GetReleaseBuildName, EmulationMode, RegistryValueKind.DWord)
Regkey.SetValue(GetDebugBuildName, EmulationMode, RegistryValueKind.DWord)
End Using
End Sub
Public Shared Sub DeleteRenderingModeRegkey()
Using Regkey As RegistryKey = Registry.CurrentUser.CreateSubKey(FEATURE_BROWSER_EMULATION)
Regkey.DeleteValue(GetReleaseBuildName)
Regkey.DeleteValue(GetDebugBuildName)
End Using
End Sub
Private Shared Function GetReleaseBuildName() As String
Return Path.GetFileName(Application.ExecutablePath)
End Function
Private Shared Function GetDebugBuildName() As String
Return GetReleaseBuildName.Replace(".exe", ".svhost.exe")
End Function
End Class
検索
VB.NET Tips
3Dプリンター