Option Explicit On
Option Strict On
Imports System.Runtime.InteropServices
Imports System.ComponentModel
Imports mshtml
Imports SHDocVw
Imports Shell32
Imports System.IO
Public Class Form1
Private Const WebPage1 As String = "https://print-kids.net/"
Private Const WebPage2 As String = "http://happylilac.net/"
Private IEList As List(Of InternetExplorer)
Private WithEvents Timer1 As New Timer
Private ListBox1 As New ListBox
Private WithEvents Button1 As New Button
Private StatusStrip1 As New StatusStrip
Private ProgressBar1 As New ToolStripProgressBar
Private StatusLabel1 As New ToolStripStatusLabel
Private WithEvents BackgroundWorker1 As New BackgroundWorker
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.Size = New Size(640, 320)
Me.Text = "ぷりんときっず・ちびむすドリルダウンローダー"
Me.ListBox1.Size = New Size(600, 180)
Me.ListBox1.Location = New Point(12, 12)
Me.ListBox1.Font = New Font(Me.ListBox1.Font.FontFamily, 12.0)
Me.Button1.Size = New Size(150, 50)
Me.Button1.Location = New Point(462, 200)
Me.Button1.Text = "ダウンロード"
Me.StatusLabel1.Dock = DockStyle.Fill
Me.ProgressBar1.Minimum = 0
Me.StatusStrip1.Items.AddRange({Me.ProgressBar1, Me.StatusLabel1})
Me.Controls.AddRange({Me.ListBox1, Me.Button1, Me.StatusStrip1})
Me.Timer1.Interval = 1000
Me.Timer1.Start()
End Sub
Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
Me.Timer1.Stop()
ReleaseIE()
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
For Each IE As InternetExplorer In IEList
Dim Title As String = IE.LocationName
Title = Title.Replace("｜", "|")
Dim Index As Integer = Title.IndexOf("|")
If Index > 0 Then
Title = Title.Substring(0, Title.IndexOf("|")).Trim(" "c)
End If
Dim DownloadDir As String = Path.Combine(My.Computer.FileSystem.SpecialDirectories.Desktop, Title)
If Not Directory.Exists(DownloadDir) Then
My.Computer.FileSystem.CreateDirectory(Path.Combine(DownloadDir))
End If
Dim Document As HTMLDocument = Nothing
Dim AnchorTags As IHTMLElementCollection = Nothing
Dim DownloadList As New List(Of String)
Try
Document = DirectCast(IE.Document, HTMLDocument)
AnchorTags = Document.getElementsByTagName("a")
For Each AnchorTag As IHTMLAnchorElement In AnchorTags
Dim href As String = Nothing
Try
href = Uri.EscapeUriString(AnchorTag.href)
If Path.GetExtension(href).ToLower = ".pdf" AndAlso Not DownloadList.Contains(href) Then
DownloadList.Add(AnchorTag.href)
End If
Catch ex As Exception
Finally
If AnchorTag IsNot Nothing AndAlso Marshal.IsComObject(AnchorTag) Then
Marshal.FinalReleaseComObject(AnchorTag)
End If
AnchorTag = Nothing
End Try
Next
Catch ex As Exception
Finally
If AnchorTags IsNot Nothing AndAlso Marshal.IsComObject(AnchorTags) Then
Marshal.FinalReleaseComObject(AnchorTags)
End If
AnchorTags = Nothing
If Document IsNot Nothing AndAlso Marshal.IsComObject(Document) Then
Marshal.FinalReleaseComObject(Document)
End If
Document = Nothing
End Try
Dim Progress As Integer = 0
Me.BackgroundWorker1.ReportProgress(DownloadList.Count, {"SetMaximum", ""})
For Each Download As String In DownloadList
Dim DownloadFileName As String = Path.Combine(DownloadDir, Path.GetFileName(Download))
If Not File.Exists(DownloadFileName) Then
Me.BackgroundWorker1.ReportProgress(Progress, {"Downloading", Path.GetFileName(Download)})
My.Computer.Network.DownloadFile(Download, DownloadFileName)
Else
Me.BackgroundWorker1.ReportProgress(Progress, {"Skipped", Path.GetFileName(Download)})
Threading.Thread.Sleep(10)
End If
Progress += 1
Next
Me.BackgroundWorker1.ReportProgress(Nothing, {"Completed", ""})
Next
End Sub
Private Sub BackgroundWorker1_ProgressChanged(sender As Object, e As ProgressChangedEventArgs) Handles BackgroundWorker1.ProgressChanged
Dim UserState As String() = DirectCast(e.UserState, String())
Dim StatusText As String = e.ProgressPercentage + 1 & "/" & Me.ProgressBar1.Maximum & " " & UserState(1)
Select Case UserState(0)
Case "SetMaximum"
Me.ProgressBar1.Maximum = e.ProgressPercentage
Case "Downloading"
SetProgressBar(e.ProgressPercentage)
Me.StatusLabel1.Text = StatusText & " ダウンロード中..."
Case "Skipped"
SetProgressBar(e.ProgressPercentage)
Me.StatusLabel1.Text = StatusText & " スキップ"
Case "Completed"
SetProgressBar(Me.ProgressBar1.Maximum)
Me.StatusLabel1.Text = "ダウンロード完了"
End Select
Me.StatusStrip1.Refresh()
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
Me.Timer1.Start()
Me.Button1.Enabled = True
End Sub
Private Sub SetProgressBar(Value As Integer)
If Value < Me.ProgressBar1.Maximum Then
Me.ProgressBar1.Value = Value + 1
Me.ProgressBar1.Value = Value
Else
Me.ProgressBar1.Maximum += 1
Me.ProgressBar1.Value = Value + 1
Me.ProgressBar1.Value = Value
Me.ProgressBar1.Maximum -= 1
End If
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
DirectCast(sender, Button).Enabled = False
Me.Timer1.Stop()
Me.BackgroundWorker1.WorkerReportsProgress = True
Me.BackgroundWorker1.RunWorkerAsync()
End Sub
Private Sub Time1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ReleaseIE()
GetIEList()
Me.ListBox1.Items.Clear()
For Each IE As InternetExplorer In IEList
Me.ListBox1.Items.Add(IE.LocationName)
Next
End Sub
Private Sub ReleaseIE()
If IEList Is Nothing Then Exit Sub
For Each IE As InternetExplorer In IEList
If IE IsNot Nothing AndAlso Marshal.IsComObject(IE) Then
Marshal.FinalReleaseComObject(IE)
End If
IE = Nothing
Next
IEList.Clear()
IEList = Nothing
End Sub
Private Sub GetIEList()
IEList = New List(Of InternetExplorer)
Dim Shell As Shell = Nothing
Dim ShellWindows As ShellWindows = Nothing
Try
Shell = New Shell
ShellWindows = DirectCast(Shell.Windows, ShellWindows)
Dim Document As Object = Nothing
For Each ie As InternetExplorer In ShellWindows
Try
If ie.ReadyState >= WebBrowserReadyState.Interactive Then
Document = ie.Document
If TypeOf Document Is HtmlDocument Then
If ie.LocationURL.StartsWith(WebPage1) Or ie.LocationURL.StartsWith(WebPage2) Then
IEList.Add(ie)
ie = Nothing
End If
End If
End If
Catch ex As Exception
Finally
If Document IsNot Nothing AndAlso Marshal.IsComObject(Document) Then
Marshal.FinalReleaseComObject(Document)
End If
Document = Nothing
If ie IsNot Nothing AndAlso Marshal.IsComObject(ie) Then
Marshal.FinalReleaseComObject(ie)
End If
ie = Nothing
End Try
Next
Catch ex As Exception
Finally
If ShellWindows IsNot Nothing AndAlso Marshal.IsComObject(ShellWindows) Then
Marshal.FinalReleaseComObject(ShellWindows)
End If
ShellWindows = Nothing
If Shell IsNot Nothing AndAlso Marshal.IsComObject(Shell) Then
Marshal.FinalReleaseComObject(Shell)
End If
Shell = Nothing
End Try
End Sub
End Class