ドイツ語辞書切り出しツール（作りかけ2）

TODO

• IMGタグの削除
• 処理状況の表示
• 空行のあらかじめの削除

【今日の進行状況】
眠いので寝る。Unicodeで書かれたウムラウトをSift_JISに変換するのは勝手にやってくれるみたい。よかった。

あとエスツェトが「s」に変換されてしまって検索できない（「ss」にしなければならないみたい）のに対応した。

あとなんでかわかんないけど"Vater"（「父」の意味）でひくと文字化けするのはなんでだろ？べつに支障はきたさないのだけど、フシギ。→http://www5.mediagalaxy.co.jp/sanshushadj/

あ、ちなみに書いてなかったけど、コードはVBです。

ほぼ完成なんだよな。ぼくの求めていたものに。
あとはテーブルに出力して女性名詞だったら「f」とか、品詞を「形」とか、そんな感じでやれたらいいかな、と。

あとは英語辞書とフランス語辞書にも対応させて、一応完成、ですかね。

Imports System
Imports System.IO
Imports System.Net
Imports System.Web
Imports System.Text
Imports System.Collections
Imports System.Threading


Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Windows フォーム デザイナで生成されたコード "
（略）
#End Region

    Public Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Dim enc As Encoding = Encoding.GetEncoding("Shift_JIS")
        Dim wd As String
        Dim url As String = "http://www5.mediagalaxy.co.jp/CGI/sanshushadj/search.cgi"
        Dim param As String
        Dim html As String
        TextBox1.Text = Trim(TextBox1.Text)

        'プログレスバー最大値
        ProgressBar1.Maximum = TextBox1.Lines.GetUpperBound(0)
        '出力ファイルを削除
        If File.Exists(Directory.GetCurrentDirectory & "\tempresult.txt") Then
            File.Delete(Directory.GetCurrentDirectory & "\tempresult.txt")
        End If
        If File.Exists(Directory.GetCurrentDirectory & "\result.htm") Then
            File.Delete(Directory.GetCurrentDirectory & "\result.htm")
        End If

        ''ここからを単語数ぶんくりかえす

        Dim i As Integer
        For i = 0 To TextBox1.Lines.GetUpperBound(0)

            Try

                'ポストデータの作成
                wd = TextBox1.Lines(i)
                'エスツェト対策
                If wd.IndexOf("(エスツェト←UTF-8で)") > 0 Then
                    wd = wd.Replace("エスツェト←UTF-8で", "ss")
                End If

                param = ""
                Dim ht As Hashtable = New Hashtable

                ht("key_word") = HttpUtility.UrlEncode(wd, enc)
                ht("cmd") = "list"

                For Each k As String In ht.Keys
                    param = param & String.Format("{0}={1}&", k, ht(k))
                Next

                Dim data As Byte() = Encoding.GetEncoding("Shift_JIS").GetBytes(param)

                'リクエストの作成
                Dim req As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
                req.Method = "POST"
                'req.ContentType = "application/x-www-form-urlencoded"
                'req.ContentLength = data.Length

                'ポストデータの書き込み
                Dim reqStream As Stream = req.GetRequestStream()
                reqStream.Write(data, 0, data.Length)
                reqStream.Close()


                'レスポンスの取得と書き込み
                Dim res As WebResponse = req.GetResponse
                Dim resStream As Stream = res.GetResponseStream
                Dim sr As StreamReader = New StreamReader(resStream, enc)
                html = sr.ReadToEnd
                sr.Close()
                resStream.Close()


                ''ここで取得できるのは検索結果一覧
                '最初のHREFを取得
                Dim stMrk8 As String = "<A HREF="""
                Dim rstart As Integer = html.IndexOf(stMrk8) + stMrk8.Length
                Dim rend As Integer = html.IndexOf(""">", rstart)
                Dim result As String = html.Substring(rstart, rend - rstart)

                Console.WriteLine(result)

                ''最初のHREFのページ取得
                Dim scResult As String = result

                req = CType(WebRequest.Create(scResult), HttpWebRequest)

                res = req.GetResponse
                resStream = res.GetResponseStream
                sr = New StreamReader(resStream, enc)

                '改行を消す
                html = ""
                Do
                    html = String.Concat(html, sr.ReadLine)
                Loop Until sr.ReadLine Is Nothing

                sr.Close()
                resStream.Close()


                ''欲しい部分だけ切り取り
                'いったん出力/debug
                Dim swFileb As New StreamWriter(Directory.GetCurrentDirectory & "\tempresult.txt", _
                                                True, Encoding.Default)
                swFileb.WriteLine(html)
                swFileb.Close()
                '/debug

                'HTML出力
                'body内を切り出し、タグを消去
                Dim stMrk1 As String = "<BODY"
                Dim stMrk2 As String = ">"

                rstart = html.IndexOf(stMrk1) + stMrk1.Length
                rstart = html.IndexOf(stMrk2, rstart) + stMrk2.Length

                Dim edMrk1 As String = "</BODY"
                rend = html.IndexOf(edMrk1, rstart)

                result = html.Substring(rstart, rend - rstart)

                'ゴミ掃除
                Dim iDel1 As Integer = 0
                Dim iDel2 As Integer

                Do
                    iDel1 = result.IndexOf("<", iDel1)
                    If iDel1 = -1 Then Exit Do
                    iDel2 = result.IndexOf(">", iDel1 + 1)
                    result = result.Remove(iDel1, iDel2 - iDel1 + 1)
                Loop Until iDel1 = -1

                If result.IndexOf("検索結果") > -1 Then
                    iDel1 = result.IndexOf("検索")
                    iDel2 = result.IndexOf("]")
                    result = result.Remove(iDel1, iDel2 - iDel1 + 1)
                End If

                Dim swFile As New StreamWriter(Directory.GetCurrentDirectory & "\result.htm", _
                                                True, Encoding.Default)
                swFile.WriteLine(String.Concat(result, "<BR>"))
                swFile.Close()

            Catch ex As Exception

                If wd <> "" Then
                    'いったん出力
                    Dim swFileR As New StreamWriter(Directory.GetCurrentDirectory & "\tempresult.txt", _
                                                True, Encoding.Default)
                    swFileR.WriteLine(wd & "の検索結果を取得できませんでした")
                    swFileR.Close()
                    '/debug

                    'HTML出力
                    Dim swFileRh As New StreamWriter(Directory.GetCurrentDirectory & "\result.htm", _
                                                True, Encoding.Default)
                    swFileRh.WriteLine(wd & "の検索結果を取得できませんでした<BR>")
                    swFileRh.Close()
                End If

            End Try

            ''ここまでを単語ぶん繰り返す
            ProgressBar1.Value = i

        Next

        MessageBox.Show("おわったよ")
        ProgressBar1.Value = 0


    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'プログレスバーの初期値
        ProgressBar1.Minimum = 0
        ProgressBar1.Value = 0

    End Sub
End Class