Imports System
Imports System.IO
Imports System.Text
Imports System.Text.RegularExpressions
Module Module1

    Public Sub Main()
        Dim list As String() = {
            "http://cms1.ishikawa-c.ed.jp/~shough/NC2/htdocs/?action=common_download_main&upload_id=4537",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample0.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample1.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample2.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample3.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample4.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample5.php",
            "http://www.vb-user.net/junk/replySamples/2018.09.22.19.00/sample6.php"
        }
        Dim encodes As String() = New String() {"ISO-8859-1", "iso-2022-jp", "Shift_JIS", "UTF-8", "euc-jp"}

        For Each url In list
            Console.WriteLine("【" & url & "】")
            Console.WriteLine()

            '★ファイル名を調べるメソッド★
            Dim result = GetConentDisposition(New Uri(url))

            For i = 0 To encodes.Length - 1
                If If(result(i).FileNameStar, result(i).FileName) IsNot Nothing Then
                    '大抵のブラウザーは、filename*= を優先的に利用しているようです。 
                    Console.WriteLine(encodes(i) & " として解釈した場合：")
                    Console.WriteLine("  filename*=" & result(i).FileNameStar)
                    Console.WriteLine("  filename=" & result(i).FileName)
                    Console.WriteLine()
                End If
            Next
            Console.WriteLine()
        Next
        Console.Write("Hit Enter Key...")
        Console.ReadLine()
    End Sub

    '5 つの要素を持つ一次元配列として返却
    '(0) は、HTTP ヘッダーを CP28591 (Latin1 あるいは ISO-8859-1) として解析した場合
    '(1) は、HTTP ヘッダーを CP50220 (iso-2022-jp) として解析した場合
    '(2) は、HTTP ヘッダーを CP932 (Shift_JIS あるいは csWindows31J) として解析した場合
    '(3) は、HTTP ヘッダーを CP65001 (UTF-8) として解析した場合
    '(4) は、HTTP ヘッダーを CP51932 (euc-jp) として解析した場合
    Public Function GetConentDisposition(url As Uri) As System.Net.Http.Headers.ContentDispositionHeaderValue()
        Const headerName As String = "content-disposition:"
        Dim ms As New MemoryStream()

        'curl.exe コマンドで HTTP HEAD リクエストを投げる
        Using p As New Process()
            Dim psi As ProcessStartInfo = p.StartInfo
            If IntPtr.Size = 8 Then
                psi.FileName = Path.Combine(Environment.SystemDirectory, "curl.exe")
            Else
                psi.FileName = Path.Combine(Environment.GetEnvironmentVariable("WINDIR"), "Sysnative", "curl.exe")
            End If
            psi.Arguments = String.Format("""{0}"" -I -s", url)
            psi.CreateNoWindow = True
            psi.UseShellExecute = False
            psi.RedirectStandardOutput = True
            psi.StandardOutputEncoding = System.Text.Encoding.GetEncoding(28591)
            p.Start()
            p.StandardOutput.BaseStream.CopyTo(ms)
            p.WaitForExit()
        End Using

        Dim rawHeaders As Byte() = ms.ToArray()
        Dim result As System.Net.Http.Headers.ContentDispositionHeaderValue()

        '元のエンコードが不明なので、いろいろ試してみる
        Dim codePages As Integer() = {28591, 50220, 932, 65001, 51932}
        result = Enumerable.Repeat(Of LooseContentDispositionHeaderValue)(Nothing, codePages.Length).ToArray()
        For idx = 0 To codePages.Length - 1
            result(idx) = LooseContentDispositionHeaderValue.LooseParse("INLINE")

            Dim enc = Encoding.GetEncoding(codePages(idx), New EncoderReplacementFallback(), New DecoderExceptionFallback())
            Dim strHeaders As String = Nothing
            Try
                strHeaders = enc.GetString(rawHeaders)
            Catch ex As DecoderFallbackException
                '文字列化に失敗したので解析をスキップ
                Debug.WriteLine(ex.ToString())
                Continue For
            End Try

            '文字列化に成功したので、CrLf で区切っていく
            Dim lines As List(Of String) = strHeaders.Split(New String() {vbCrLf}, StringSplitOptions.None).ToList()

            'RFC 2616 # Section 2.2 の『LWS』は、ここでは考慮していません。
            'Internet Explorer(～11) は LWS を正しく処理できませんし
            'そもそも HTTP ヘッダでの LWS は RFC 7230 で禁止されたはず。

            For Each line In lines.Where(Function(s) s.ToLowerInvariant().StartsWith(headerName))
                'content-disposition ヘッダーからファイル名を取得。
                result(idx) = LooseContentDispositionHeaderValue.LooseParse(line.Substring(headerName.Length).TrimStart())
                Exit For
            Next
        Next

        Return result
    End Function


    'Content-Disposition ヘッダーを解析して filename を切り出すためのクラス
    Private Class LooseContentDispositionHeaderValue
        Inherits System.Net.Http.Headers.ContentDispositionHeaderValue

        Private Shared ReadOnly re As New Regex(
            "(?<key>filename\*?)\s*=\s*" &
            "(?:                       " &
            "  ""(?<value>[^""]*)""    " &
            "  |                       " &
            "  (?<value>[^;]*)         " &
            ")                         " _
            , RegexOptions.IgnoreCase Or RegexOptions.IgnorePatternWhitespace)

        Private Sub New(dispositionType As String)
            MyBase.New(If(dispositionType, "INLINE"))
        End Sub

        Public Shared Function LooseParse(value As String) As LooseContentDispositionHeaderValue
            Dim dispositionType As String = value.Split(";"c).First().Trim()
            Dim result As New LooseContentDispositionHeaderValue(dispositionType)

            For Each m As Match In re.Matches(value)
                If m.Groups("key").Value.EndsWith("*") Then
                    '【RFC 5987】　
                    'filename*=utf-8'ja-JP'%c2%a3rates
                    'filename*=shift_jis'ja'%81%92rates
                    'filename*=euc-jp''%a1%f2rates

                    'IE 向けに空白補正が行われていた場合は、%20に復元してから渡す。
                    result.FileNameStar = DecodeFileNameStar(m.Groups("value").Value.Replace(" ", "%20"))
                Else
                    '【RFC 2616】
                    'filename=£rates
                    'filename="Pound rates"
                    'filename="=?iso-2022-jp?B?GyRCQiMbKEJyYXRlcw==?="
                    'filename="=?shift_jis?B?wqNyYXRlcw==?="
                    'filename="=?enc-jp?B?wqNyYXRlcw==?="
                    'filename="=?utf-8?B?wqNyYXRlcw==?="
                    result.FileName = DecodeFileName(m.Groups("value").Value)
                End If
            Next
            Return result
        End Function

        Private Shared Function DecodeFileName(input As String) As String
            If input.Length < 10 OrElse Not input Like """*""" Then
                Return input
            End If
            Dim parts As String() = input.Split("?"c)
            If  parts.Length = 5 AndAlso parts(0) = """=" AndAlso parts(4) = "=""" Then
                Select Case parts(2).ToUpperInvariant()
                    Case "B"    'Bエンコードの場合
                        Try
                            Dim enc = Encoding.GetEncoding(parts(1))
                            Dim binary As Byte() = Convert.FromBase64String(parts(3))
                            Return enc.GetString(binary)
                        Catch ex As ArgumentException
                        Catch ex As FormatException
                        End Try
                    Case "Q"    'Qエンコードの場合
                        'HTTP で使われる事は無いと思うので実装を省略。
                        '必要なら "quoted-printable" で検索すればサンプルが見つかるはず。
                        Return Nothing
                End Select
            End If

            'B エンコードせずに出力されていた場合(IE向けサイトなど)
            Return input
        End Function


        'RFC 5987 に従ってデコード
        Private Shared Function DecodeFileNameStar(input As String) As String
            Dim quoteIndex As Integer = input.IndexOf("'"c)
            If quoteIndex = -1 Then
                Return Nothing
            End If
            Dim lastQuoteIndex = input.LastIndexOf("'"c)
            If quoteIndex = lastQuoteIndex Then
                Return Nothing
            End If
            Dim encodingString = input.Substring(0, quoteIndex)
            Dim dataString = input.Substring(lastQuoteIndex + 1, input.Length - (lastQuoteIndex + 1))
            Dim decoded As New StringBuilder()
            Try
                Dim enc = Encoding.GetEncoding(encodingString)
                Dim unescaped(dataString.Length - 1) As Byte
                Dim unescapedBytesCount As Integer = 0
                For index = 0 To dataString.Length - 1
                    If Uri.IsHexEncoding(dataString, index) Then
                        unescaped(unescapedBytesCount) = CByte(AscW(Uri.HexUnescape(dataString, index)))
                        unescapedBytesCount += 1
                        index -= 1
                    Else
                        If unescapedBytesCount > 0 Then
                            decoded.Append(enc.GetString(unescaped, 0, unescapedBytesCount))
                            unescapedBytesCount = 0
                        End If
                        decoded.Append(dataString(index))
                    End If
                Next
                If unescapedBytesCount > 0 Then
                    decoded.Append(enc.GetString(unescaped, 0, unescapedBytesCount))
                End If
            Catch ex As ArgumentException
                Return Nothing
            End Try
            Return decoded.ToString()
        End Function
    End Class

End Module