Option Explicit On
Option Strict On

Imports System.ComponentModel
Imports System.IO
Imports Microsoft.Win32

Public Class Form1

    Private ToolStrip As New ToolStrip With {.ImageScalingSize = New Size(48, 48)}
    Private WithEvents DownloadButton As New ToolStripButton With {.AutoSize = True,
                                                                   .ImageAlign = ContentAlignment.BottomCenter,
                                                                   .ImageScaling = ToolStripItemImageScaling.SizeToFit,
                                                                   .Text = "ダウンロード",
                                                                   .TextAlign = ContentAlignment.BottomCenter,
                                                                   .DisplayStyle = ToolStripItemDisplayStyle.ImageAndText,
                                                                   .Size = New Size(100, 80),
                                                                   .TextImageRelation = TextImageRelation.ImageAboveText}
    Private WithEvents Favicon As New PictureBox
    Private StatusStrip As New StatusStrip
    Private Progress As New ToolStripProgressBar
    Private Status As New ToolStripLabel
    Private Panel As New Panel With {.Dock = DockStyle.Fill}
    Private WebBrowser As New WebBrowser With {.Dock = DockStyle.Fill,
                                               .ScriptErrorsSuppressed = True}
    Private baseUrl As New Uri("https://print-kids.net/")
    Private faviconUrl As New Uri(Me.baseUrl, "/img/favicon.ico")
    Private downloadList As New List(Of link)
    Private abort As Boolean = False

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        BrowserEmulation.CreateRenderingModeRegkey(BrowserEmulation.Emulation.IE11Edge)
        Me.Text = "ぷりんときっずダウンローダー"
        Me.KeyPreview = True
        Me.Size = New Size(1024, 678)
        Me.Favicon.LoadAsync(faviconUrl.ToString)
        Me.ToolStrip.Items.Add(Me.DownloadButton)
        Me.StatusStrip.Items.AddRange({Me.Progress, Me.Status})
        Me.Panel.Controls.Add(Me.WebBrowser)
        Me.Controls.AddRange({Me.StatusStrip, Me.Panel, Me.ToolStrip})
        Me.WebBrowser.Navigate(Me.baseUrl)
    End Sub

    Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing
        BrowserEmulation.DeleteRenderingModeRegkey()
    End Sub

    Private Sub Favicon_LoadCompleted(sender As Object, e As AsyncCompletedEventArgs) Handles Favicon.LoadCompleted
        Me.DownloadButton.Image = Me.Favicon.Image
        Me.Icon = Icon.FromHandle(DirectCast(Me.Favicon.Image, Bitmap).GetHicon)
        Dialog1.Icon = Me.Icon
    End Sub

    Private Sub Download_Click(sender As Object, e As EventArgs) Handles DownloadButton.Click
        Me.Panel.Enabled = False
        Me.DownloadButton.Enabled = False
        Me.abort = False
        AddHandler Me.WebBrowser.DocumentCompleted, AddressOf WebBrowser_DocumentCompleted
        Me.WebBrowser.Navigate(Me.WebBrowser.Url)
    End Sub

    Private Sub WebBrowser_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs)
        Static downloadList As New List(Of link)
        Dim browser As WebBrowser = DirectCast(sender, WebBrowser)
        If e.Url.Equals(browser.Url) Then
            Dim document As HtmlDocument = browser.Document
            Dim panNav As String = document.GetElementById("pan-nav")?.GetElementsByTagName("span") _
                                           .Cast(Of HtmlElement) _
                                           .Select(Function(spanTag) spanTag.InnerText) _
                                           .Aggregate(String.Empty, Function(retValue As String, title As String) Path.Combine(retValue, title))
            Select Case True
                Case document.GetElementById("topic").GetElementsByTagName("section").Count > 0
                    'PDFダウンロードページ
                    downloadPdfs(document, downloadList, panNav)
                Case document.GetElementById("menu").GetElementsByTagName("aside")(1).GetAttribute("className") = "text-anime"
                    'サブカテゴリのページ
                    Dim categoryLinks = document.GetElementById("menu").GetElementsByTagName("aside")(1).GetElementsByTagName("a") _
                                                .Cast(Of HtmlElement) _
                                                .Select(Function(anchorElement) New link(New Uri(anchorElement.GetAttribute("href")), anchorElement.InnerText))
                    downloadCategories(document, downloadList, categoryLinks, panNav)
                Case Else
                    'カテゴリページ（ホームページ）
                    Dim categoryLinks = document.GetElementById("picture").GetElementsByTagName("a") _
                                                .Cast(Of HtmlElement) _
                                                .Select(Function(anchorElement) New link(New Uri(anchorElement.GetAttribute("href")), anchorElement.InnerText))
                    downloadCategories(document, downloadList, categoryLinks, panNav)
            End Select
            'ダウンロードリストのページを開く
            If downloadList.Count > 0 Then
                Dim lastItem As link = downloadList.Last
                downloadList.Remove(lastItem)
                Me.WebBrowser.Navigate(lastItem.Uri)
            Else
                RemoveHandler Me.WebBrowser.DocumentCompleted, AddressOf WebBrowser_DocumentCompleted
                Me.Panel.Enabled = True
                Me.DownloadButton.Enabled = True
                Me.WebBrowser.Document.Focus()
            End If
        End If
    End Sub

    'カテゴリのリンクをダウンロードリストに格納し，ダウンロード開始
    Private Sub downloadCategories(document As HtmlDocument, downloadList As List(Of link), categorylinks As IEnumerable(Of link), panNav As String)
        If downloadList.Count > 0 Then
            downloadList.AddRange(categorylinks.Reverse)
        Else
            Dialog1.CheckedListBox.Items.AddRange(categorylinks.ToArray)
            For i As Integer = 0 To Dialog1.CheckedListBox.Items.Count - 1
                Dialog1.CheckedListBox.SetItemChecked(i, True)
            Next
            Dim Category As String = Path.GetFileName(panNav)
            Dialog1.Text = If(Category = "", "大カテゴリを選択してダウンロード", Category & "カテゴリから選択してダウンロード")
            Dialog1.ShowDialog()
            If Dialog1.DialogResult = DialogResult.OK Then
                downloadList.AddRange(Dialog1.CheckedListBox.CheckedItems.Cast(Of link).Reverse)
            End If
            Dialog1.CheckedListBox.Items.Clear()
        End If
    End Sub

    Private Sub downloadPdfs(document As HtmlDocument, downloadList As List(Of link), panNav As String)
        'PDFのサムネイルまでスクロール
        document.GetElementsByTagName("section")(0).ScrollIntoView(True)
        'PDFファイルのリンクのリストを取得
        Dim pdfLinks = document.GetElementById("topic").GetElementsByTagName("a") _
                               .Cast(Of HtmlElement) _
                               .Select(Function(anchorElement) New With {.Uri = New Uri(anchorElement.GetAttribute("href")), .HtmlElement = anchorElement}) _
                               .Where(Function(anchorElement) baseUrl.IsBaseOf(anchorElement.Uri) AndAlso Path.GetExtension(anchorElement.Uri.AbsoluteUri).ToLower = ".pdf") _
                               .Select(Function(anchorElement) New link(anchorElement.Uri, anchorElement.HtmlElement.GetElementsByTagName("p")(0).InnerText))
        'パンくずリストをPath形式で取得
        Dim downloadDir = panNav.Replace("ホーム\無料プリント", "ぷりんときっず")
        'ダウンロード先フォルダ作成
        downloadDir = Path.Combine(My.Computer.FileSystem.SpecialDirectories.Desktop, downloadDir)
        If Not Directory.Exists(downloadDir) Then
            My.Computer.FileSystem.CreateDirectory(Path.Combine(downloadDir))
        End If
        'PDFファイルをダウンロード
        Dim Progress As Integer = 0
        Me.Progress.Maximum = pdfLinks.Count
        SetProgress(Progress, "")
        For Each pdfLink As link 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 = " スキップ（ESCキーで停止）"
            If Not File.Exists(DownloadFileName) Then
                My.Computer.Network.DownloadFile(pdfLink.Uri, DownloadFileName)
                Status = " ダウンロード中...（ESCキーで停止）"
            End If
            SetProgress(Progress, Progress + 1 & "/" & Me.Progress.Maximum & " " & Path.GetFileName(downloadDir) & " " & DownloadUrl & " " & Status)
            Progress += 1
            'ESCキーで停止する
            If abort Then
                SetProgress(Progress, "ダウンロード停止")
                downloadList.Clear()
                Exit Sub
            End If
        Next
        SetProgress(Me.Progress.Maximum, Path.GetFileName(downloadDir) & " ダウンロード完了")
    End Sub

    'プログレスバーのバーを即時に伸ばす
    '参考 dobon.net https://dobon.net/vb/dotnet/control/pbdisableanimation.html
    Private Sub SetProgress(Value As Integer, Message As String)
        Me.Progress.Maximum += 1
        Me.Progress.Value = Value + 1
        Me.Progress.Value -= 1
        Me.Progress.Maximum -= 1
        Me.Status.Text = Message
        Me.StatusStrip.Refresh()
    End Sub

    Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        Me.abort = (e.KeyData = Keys.Escape)
    End Sub

    Private Class link

        Property Uri As Uri
        Property Text As String

        Public Sub New(Uri As Uri, Text As String)
            Me.Uri = Uri
            Me.Text = Text
        End Sub

        Public Overrides Function ToString() As String
            Return Me._Text
        End Function

    End Class

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