• R/O
  • SSH
  • HTTPS

コミット

タグ
未設定

よく使われているワード(クリックで追加)

javaandroidc++linuxc#objective-ccocoa誰得qtrubybathyscaphegamephpguiwindowsc翻訳pythonomegattwitterframeworkbtronarduinovb.net計画中(planning stage)directxpreviewertestゲームエンジンdom

将棋ウォーズ棋譜を検索条件を指定して一括でダウンロードする。


コミットメタ情報

リビジョン11 (tree)
日時2015-01-31 14:15:32
作者bellyoshi

ログメッセージ

変更サマリ

差分

--- ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/frmProgress.vb (revision 10)
+++ ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/frmProgress.vb (revision 11)
@@ -19,8 +19,8 @@
1919 If downloder.IsDownloading Then
2020 Me.Text = String.Format("棋譜ダウンロード中({0}/{1})",
2121 downloder.DownLoadIndex,
22- downloder.DownLoadsListsCount)
23- pbProgress.Maximum = downloder.DownLoadsListsCount
22+ downloder.DownLoadsCount)
23+ pbProgress.Maximum = downloder.DownLoadsCount
2424 pbProgress.Value = downloder.DownLoadIndex
2525 End If
2626 If downloder.IsComplete Then
--- ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/gTypeDirectoryPair.vb (revision 10)
+++ ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/gTypeDirectoryPair.vb (revision 11)
@@ -2,6 +2,8 @@
22
33 Public Property gType As Integer
44 Public Property saveDirectoryPathName As String
5+ Public Property List As IList(Of aLink)
6+ Public Property DownloadIndexOfList As Integer = 0
57
68 Private Sub New()
79 End Sub
--- ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/downloder.vb (revision 10)
+++ ShogiWarsKifuDownloader/ShogiWarsKifuDownloader/downloder.vb (revision 11)
@@ -3,15 +3,36 @@
33 Public Property backGroudWoker As System.ComponentModel.BackgroundWorker
44 Private baseUrl As String = "http://swks.sakura.ne.jp/wars/kifusearch/"
55 Private csrfmiddlewaretoken As String
6- Private downloadLists As IList(Of aLink)
76 Dim cc As System.Net.CookieContainer
87
98 Private _gTypePairList As New List(Of gTypeDirectoryPair)
9+ Private _gTypePairListIndex As Integer
1010
1111 Public Property name1 As String
1212 Public Property name2 As String
13- Public Property DownLoadsListsCount As Integer
14- Public Property DownLoadIndex As Integer
13+
14+
15+
16+ Public ReadOnly Property DownLoadIndex As Integer
17+ Get
18+ Dim idx As Integer = 0
19+ For i As Integer = 0 To _gTypePairListIndex
20+ idx += _gTypePairList(i).DownloadIndexOfList
21+ Next
22+ Return idx
23+ End Get
24+ End Property
25+
26+ Public ReadOnly Property DownLoadsCount As Integer
27+ Get
28+ Dim count As Integer = 0
29+ For Each p As gTypeDirectoryPair In _gTypePairList
30+ count += p.List.Count
31+ Next
32+ Return count
33+ End Get
34+ End Property
35+
1536 Public Property IsDownloading As Boolean = False
1637 Public Property IsComplete As Boolean = False
1738
@@ -27,7 +48,7 @@
2748 _gTypePairList.Add(pair)
2849 End Sub
2950
30- Public Sub AddGD(ByVal gtype As Integer, saveDirectory As String)
51+ Public Sub AddGD(ByVal gtype As Integer, ByVal saveDirectory As String)
3152 AddGtypeDirectoryPair(New gTypeDirectoryPair(gtype, saveDirectory))
3253 End Sub
3354
@@ -34,12 +55,15 @@
3455 Public Sub Start()
3556 _backGroudWoker.ReportProgress(0, "ログイン開始")
3657 LoginReq()
58+ _backGroudWoker.ReportProgress(0, "一覧取得中")
3759 For Each p As gTypeDirectoryPair In _gTypePairList
38- _backGroudWoker.ReportProgress(0, "一覧取得中")
39- ListPageReadReq(p.gType)
40- _backGroudWoker.ReportProgress(0, "ダウンロード開始")
41- DownLoadsReq(p.saveDirectoryPathName)
60+ ListPageReadReq(p)
4261 Next
62+
63+ _backGroudWoker.ReportProgress(0, "ダウンロード開始")
64+ For Me._gTypePairListIndex = 0 To _gTypePairList.Count - 1
65+ DownLoadsReq(_gTypePairList(Me._gTypePairListIndex))
66+ Next
4367 IsComplete = True
4468 _backGroudWoker.ReportProgress(100, "ダウンロード終了")
4569 End Sub
@@ -67,31 +91,30 @@
6791
6892 End Sub
6993
70- Private Sub DownLoadsReq(ByVal saveDirectory As String)
94+ Private Sub DownLoadsReq(ByVal p As gTypeDirectoryPair)
7195
7296 Dim wc As New System.Net.WebClient()
7397
74- Dim dirfullpath As String = saveDirectory
98+ Dim dirfullpath As String = p.saveDirectoryPathName
7599 If Not IOUtil.CreateDirectoryIfNotExist(dirfullpath) Then
76100 _backGroudWoker.ReportProgress(0, String.Format("ディレクトリ""{0}""が作成できません", dirfullpath))
77101 Exit Sub
78102 End If
79103
80- DownLoadIndex = 0
81104 IsDownloading = True
82- For Each link As aLink In downloadLists
105+ For Each link As aLink In p.List
83106 If backGroudWoker.CancellationPending Then
84107 Throw New CancelException
85108 End If
86- _backGroudWoker.ReportProgress(DownLoadIndex / DownLoadsListsCount, String.Format("{0}", link.Text))
109+ _backGroudWoker.ReportProgress(DownLoadIndex / DownLoadsCount, String.Format("{0}", link.Text))
87110 DownLoadOneLink(wc, link, dirfullpath)
88- DownLoadIndex += 1
111+ p.DownloadIndexOfList += 1
89112 Next
90113
91114 wc.Dispose()
92115 End Sub
93116
94- Private Sub DownLoadOneLink(wc As System.Net.WebClient, link As aLink, dirfullpath As String)
117+ Private Sub DownLoadOneLink(ByVal wc As System.Net.WebClient, ByVal link As aLink, ByVal dirfullpath As String)
95118 Dim url As String = link.Url
96119 Dim filename As String = System.IO.Path.GetFileName(url)
97120 Dim fullpath As String = dirfullpath & "/" & filename
@@ -115,21 +138,21 @@
115138
116139
117140
118- Private Sub ListPageReadReq(ByVal gType As Integer)
141+ Private Sub ListPageReadReq(ByVal p As gTypeDirectoryPair)
119142
120143 Dim ps As New Hashtable
121144 ps.Add("csrfmiddlewaretoken", csrfmiddlewaretoken)
122145 ps.Add("name1", _name1)
123146 ps.Add("name2", _name2)
124- ps.Add("gtype", gType)
147+ ps.Add("gtype", p.gType)
125148
126149 Dim encoder As System.Text.Encoding = System.Text.Encoding.UTF8
127150
128151 Dim resText As String = HttpPostUtl.HttpPost(baseUrl, ps, cc, encoder)
152+ p.DownloadIndexOfList = 0
153+ p.List = GetLinks(resText)
154+ 'Todo フォルダ上にあるファイルをリスト上から削除
129155
130- downloadLists = GetLinks(resText)
131- DownLoadsListsCount = downloadLists.Count
132-
133156 End Sub
134157
135158 Private Function GetLinks(ByVal text As String) As IList(Of aLink)