OAuth(xAuth)のVB.net実装サンプル

OAuthのVB.netサンプルです。お好きにどうぞ。
PIN入力用のメソッドもついていますが、こちらはおまけということで。
オリジナルはこちら。

はじめは備忘録として言葉でゴチャっと書いて済まそうと思ってたんですが、見てみたい、という意見を見かけたのでアップしてみた次第。おかげで見落としてた依存関係とか消せてすっきりしました。

使い方サンプル（xAuth）

初期化〜認証まで

'HttpConnectionの初期化（HttpConnection.InitializeConnection呼び出し）
'プロキシ設定と通信タイムアウトの設定です。はじめに一回だけ呼べばOK。
HttpConnection.InitializeConnection(20, ProxyType.IE, "", 0, 0, "", "")

'HttpConnectionOAuthのインスタンス化
Dim httpCon as New HttpConnectionOAuth

'初期化（コンシューマーキーの設定など）
httpCon.Initialize("Your consumerKey", "Your consumerSecret", "", "", "screen_name") 'screen_nameはtwitter用

'認証
Dim result As Boolean = httpCon.AuthenticateXAuth("https://api.twitter.com/oauth/access_token", "Your username", "Your password")
If result Then
    MessageBox.Show("認証成功")
Else
    MessageBox.Show("認証失敗")
End If

通信

取得はこんな感じ。

Dim param As New Dictionary(Of String, String)
param.Add("count", 20)

Dim content As String = ""
Dim statusCode As HttpStatusCode = _
    httpCon.GetContent("GET", _
                            New Uri("http://api.twitter.com/1/statuses/home_timeline.xml"), _
                            param, _
                            content, _
                            Nothing)

更新も同じ。

Dim param As New Dictionary(Of String, String)
param.Add("status", "更新しちゃうよ！")

Dim content As String = ""
Dim statusCode As HttpStatusCode = _
    httpCon.GetContent("POST", _
                            New Uri("http://api.twitter.com/1/statuses/update.xml"), _
                            param, _
                            content, _
                            Nothing)

ソース

HTTP通信の大元。ストリームとか画像取得とかのメソッドは省略してあります。

Imports System.Net
Imports System.IO
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.Text

'''<summary>
'''HttpWebRequest,HttpWebResponseを使用した基本的な通信機能を提供する
'''</summary>
'''<remarks>
'''プロキシ情報などを設定するため、使用前に静的メソッドInitializeConnectionを呼び出すこと。
'''通信方式によって必要になるHTTPヘッダの付加などは、派生クラスで行う。
'''</remarks>
Public Class HttpConnection
    '''<summary>
    '''プロキシ
    '''</summary>
    Private Shared proxy As WebProxy = Nothing

    '''<summary>
    '''ユーザーが選択したプロキシの方式
    '''</summary>
    Private Shared proxyKind As ProxyType = proxyType.IE

    '''<summary>
    '''クッキー保存用コンテナ
    '''</summary>
    Private Shared cookieContainer As New CookieContainer

    '''<summary>
    '''初期化済みフラグ
    '''</summary>
    Private Shared isInitialize As Boolean = False

    Public Enum ProxyType
        None
        IE
        Specified
    End Enum

    '''<summary>
    '''HttpWebRequestオブジェクトを取得する。パラメータはGET/HEAD/DELETEではクエリに、POST/PUTではエンティティボディに変換される。
    '''</summary>
    '''<remarks>
    '''追加で必要となるHTTPヘッダや通信オプションは呼び出し元で付加すること
    '''（Timeout,AutomaticDecompression,AllowAutoRedirect,UserAgent,ContentType,Accept,HttpRequestHeader.Authorization,カスタムヘッダ）
    '''POST/PUTでクエリが必要な場合は、requestUriに含めること。
    '''</remarks>
    '''<param name="method">HTTP通信メソッド（GET/HEAD/POST/PUT/DELETE）</param>
    '''<param name="requestUri">通信先URI</param>
    '''<param name="param">GET時のクエリ、またはPOST時のエンティティボディ</param>
    '''<param name="withCookie">通信にcookieを使用するか</param>
    '''<returns>引数で指定された内容を反映したHttpWebRequestオブジェクト</returns>
    Protected Function CreateRequest(ByVal method As String, _
                                            ByVal requestUri As Uri, _
                                            ByVal param As Dictionary(Of String, String), _
                                            ByVal withCookie As Boolean _
                                        ) As HttpWebRequest
        If Not isInitialize Then Throw New Exception("Sequence error.(not initialized)")

        'GETメソッドの場合はクエリとurlを結合
        Dim ub As New UriBuilder(requestUri.AbsoluteUri)
        If method = "GET" OrElse method = "DELETE" OrElse method = "HEAD" Then
            ub.Query = CreateQueryString(param)
        End If

        Dim webReq As HttpWebRequest = DirectCast(WebRequest.Create(ub.Uri), HttpWebRequest)

        'プロキシ設定
        If proxyKind <> ProxyType.IE Then webReq.Proxy = proxy

        webReq.Method = method
        If method = "POST" OrElse method = "PUT" Then
            webReq.ContentType = "application/x-www-form-urlencoded"
            'POST/PUTメソッドの場合は、ボディデータとしてクエリ構成して書き込み
            Using writer As New StreamWriter(webReq.GetRequestStream)
                writer.Write(CreateQueryString(param))
            End Using
        End If
        'cookie設定
        If withCookie Then webReq.CookieContainer = cookieContainer
        'タイムアウト設定
        webReq.Timeout = DefaultTimeout

        Return webReq
    End Function

    '''<summary>
    '''HTTPの応答を処理し、応答ボディデータをテキストとして返却する
    '''</summary>
    '''<remarks>
    '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
    '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
    '''テキストの文字コードはUTF-8を前提として、エンコードはしていません
    '''</remarks>
    '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
    '''<param name="contentText">[OUT]HTTP応答のボディデータ</param>
    '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
    '''<param name="withCookie">通信にcookieを使用する</param>
    '''<returns>HTTP応答のステータスコード</returns>
    Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
                                        ByRef contentText As String, _
                                        ByVal headerInfo As Dictionary(Of String, String), _
                                        ByVal withCookie As Boolean _
                                    ) As HttpStatusCode
        Try
            Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
                Dim statusCode As HttpStatusCode = webRes.StatusCode
                'cookie保持
                If withCookie Then SaveCookie(webRes.Cookies)
                'リダイレクト応答の場合は、リダイレクト先を設定
                GetHeaderInfo(webRes, headerInfo)
                '応答のストリームをテキストに書き出し
                If contentText Is Nothing Then Throw New ArgumentNullException("contentText")
                If webRes.ContentLength > 0 Then
                    Using sr As StreamReader = New StreamReader(webRes.GetResponseStream)
                        contentText = sr.ReadToEnd()
                    End Using
                End If
                Return statusCode
            End Using
        Catch ex As WebException
            If ex.Status = WebExceptionStatus.ProtocolError Then
                Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
                Return res.StatusCode
            End If
            Throw ex
        End Try
    End Function

    '''<summary>
    '''HTTPの応答を処理します。応答ボディデータが不要な用途向け。
    '''</summary>
    '''<remarks>
    '''リダイレクト応答の場合（AllowAutoRedirect=Falseの場合のみ）は、headerInfoインスタンスがあればLocationを追加してリダイレクト先を返却
    '''WebExceptionはハンドルしていないので、呼び出し元でキャッチすること
    '''</remarks>
    '''<param name="webRequest">HTTP通信リクエストオブジェクト</param>
    '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。ヘッダ名をキーにして空データのコレクションを渡すことで、該当ヘッダの値をデータに設定して戻す</param>
    '''<param name="withCookie">通信にcookieを使用する</param>
    '''<returns>HTTP応答のステータスコード</returns>
    Protected Function GetResponse(ByVal webRequest As HttpWebRequest, _
                                        ByVal headerInfo As Dictionary(Of String, String), _
                                        ByVal withCookie As Boolean _
                                    ) As HttpStatusCode
        Try
            Using webRes As HttpWebResponse = CType(webRequest.GetResponse(), HttpWebResponse)
                Dim statusCode As HttpStatusCode = webRes.StatusCode
                'cookie保持
                If withCookie Then SaveCookie(webRes.Cookies)
                'リダイレクト応答の場合は、リダイレクト先を設定
                GetHeaderInfo(webRes, headerInfo)
                Return statusCode
            End Using
        Catch ex As WebException
            If ex.Status = WebExceptionStatus.ProtocolError Then
                Dim res As HttpWebResponse = DirectCast(ex.Response, HttpWebResponse)
                Return res.StatusCode
            End If
            Throw ex
        End Try
    End Function

    '''<summary>
    '''クッキーを保存。ホスト名なしのドメインの場合、ドメイン名から先頭のドットを除去して追加しないと再利用されないため
    '''</summary>
    Private Sub SaveCookie(ByVal cookieCollection As CookieCollection)
        For Each ck As Cookie In cookieCollection
            If ck.Domain.StartsWith(".") Then
                ck.Domain = ck.Domain.Substring(1, ck.Domain.Length - 1)
                cookieContainer.Add(ck)
            End If
        Next
    End Sub

    '''<summary>
    '''headerInfoのキー情報で指定されたHTTPヘッダ情報を取得・格納する。redirect応答時はLocationヘッダの内容を追記する
    '''</summary>
    '''<param name="webResponse">HTTP応答</param>
    '''<param name="headerInfo">[IN/OUT]キーにヘッダ名を指定したデータ空のコレクション。取得した値をデータにセットして戻す</param>
    Private Sub GetHeaderInfo(ByVal webResponse As HttpWebResponse, _
                                    ByVal headerInfo As Dictionary(Of String, String))

        If headerInfo Is Nothing Then Exit Sub

        If headerInfo.Count > 0 Then
            Dim keys(headerInfo.Count - 1) As String
            headerInfo.Keys.CopyTo(keys, 0)
            For Each key As String In keys
                If Array.IndexOf(webResponse.Headers.AllKeys, key) > -1 Then
                    headerInfo.Item(key) = webResponse.Headers.Item(key)
                Else
                    headerInfo.Item(key) = ""
                End If
            Next
        End If

        Dim statusCode As HttpStatusCode = webResponse.StatusCode
        If statusCode = HttpStatusCode.MovedPermanently OrElse _
           statusCode = HttpStatusCode.Found OrElse _
           statusCode = HttpStatusCode.SeeOther OrElse _
           statusCode = HttpStatusCode.TemporaryRedirect Then
            If headerInfo.ContainsKey("Location") Then
                headerInfo.Item("Location") = webResponse.Headers.Item("Location")
            Else
                headerInfo.Add("Location", webResponse.Headers.Item("Location"))
            End If
        End If
    End Sub

    '''<summary>
    '''クエリコレクションをkey=value形式の文字列に構成して戻す
    '''</summary>
    '''<param name="param">クエリ、またはポストデータとなるkey-valueコレクション</param>
    Protected Function CreateQueryString(ByVal param As IDictionary(Of String, String)) As String
        If param Is Nothing OrElse param.Count = 0 Then Return String.Empty

        Dim query As New StringBuilder
        For Each key As String In param.Keys
            query.AppendFormat("{0}={1}&", UrlEncode(key), UrlEncode(param(key)))
        Next
        Return query.ToString(0, query.Length - 1)
    End Function

    '''<summary>
    '''クエリ形式（key1=value1&key2=value2&...）の文字列をkey-valueコレクションに詰め直し
    '''</summary>
    '''<param name="queryString">クエリ文字列</param>
    '''<returns>key-valueのコレクション</returns>
    Protected Function ParseQueryString(ByVal queryString As String) As NameValueCollection
        Dim query As New NameValueCollection
        Dim parts() As String = queryString.Split("&"c)
        For Each part As String In parts
            Dim index As Integer = part.IndexOf("="c)
            If index = -1 Then
                query.Add(Uri.UnescapeDataString(part), "")
            Else
                query.Add(Uri.UnescapeDataString(part.Substring(0, index)), Uri.UnescapeDataString(part.Substring(index + 1)))
            End If
        Next
        Return query
    End Function

    '''<summary>
    '''2バイト文字も考慮したUrlエンコード
    '''</summary>
    '''<param name="str">エンコードする文字列</param>
    '''<returns>エンコード結果文字列</returns>
    Protected Function UrlEncode(ByVal stringToEncode As String) As String
        Const UnreservedChars As String = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789-_.~"
        Dim sb As New StringBuilder
        Dim bytes As Byte() = Encoding.UTF8.GetBytes(stringToEncode)

        For Each b As Byte In bytes
            If UnreservedChars.IndexOf(Chr(b)) <> -1 Then
                sb.Append(Chr(b))
            Else
                sb.AppendFormat("%{0:X2}", b)
            End If
        Next
        Return sb.ToString()
    End Function

#Region "DefaultTimeout"
    '''<summary>
    '''通信タイムアウト時間（ms）
    '''</summary>
    Private Shared timeout As Integer = 20000

    '''<summary>
    '''通信タイムアウト時間（ms）。10〜120秒の範囲で指定。範囲外は20秒とする
    '''</summary>
    Protected Shared Property DefaultTimeout() As Integer
        Get
            Return timeout
        End Get
        Set(ByVal value As Integer)
            Const TimeoutMinValue As Integer = 10000
            Const TimeoutMaxValue As Integer = 120000
            Const TimeoutDefaultValue As Integer = 20000
            If value < TimeoutMinValue OrElse value > TimeoutMaxValue Then
                ' 範囲外ならデフォルト値設定
                timeout = TimeoutDefaultValue
            Else
                timeout = value
            End If
        End Set
    End Property
#End Region

    '''<summary>
    '''通信クラスの初期化処理。タイムアウト値とプロキシを設定する
    '''</summary>
    '''<remarks>
    '''通信開始前に最低一度呼び出すこと
    '''</remarks>
    '''<param name="timeout">タイムアウト値（秒）</param>
    '''<param name="proxyType">なし・指定・IEデフォルト</param>
    '''<param name="proxyAddress">プロキシのホスト名orIPアドレス</param>
    '''<param name="proxyPort">プロキシのポート番号</param>
    '''<param name="proxyUser">プロキシ認証が必要な場合のユーザ名。不要なら空文字</param>
    '''<param name="proxyPassword">プロキシ認証が必要な場合のパスワード。不要なら空文字</param>
    Public Shared Sub InitializeConnection( _
            ByVal timeout As Integer, _
            ByVal proxyType As ProxyType, _
            ByVal proxyAddress As String, _
            ByVal proxyPort As Integer, _
            ByVal proxyUser As String, _
            ByVal proxyPassword As String)
        isInitialize = True
        ServicePointManager.Expect100Continue = False
        DefaultTimeout = timeout * 1000     's -> ms
        Select Case proxyType
            Case proxyType.None
                proxy = Nothing
            Case proxyType.Specified
                proxy = New WebProxy("http://" + proxyAddress + ":" + proxyPort.ToString)
                If Not String.IsNullOrEmpty(proxyUser) OrElse Not String.IsNullOrEmpty(proxyPassword) Then
                    proxy.Credentials = New NetworkCredential(proxyUser, proxyPassword)
                End If
            Case proxyType.IE
                'IE設定（システム設定）はデフォルト値なので処理しない
        End Select
        proxyType = proxyType
    End Sub

End Class

それを使ったOAuth。

Imports System.Net
Imports System.Collections.Generic
Imports System.Collections.Specialized
Imports System.IO
Imports System.Text
Imports System.Security

'''<summary>
'''OAuth認証を使用するHTTP通信。HMAC-SHA1固定
'''</summary>
'''<remarks>
'''使用前に認証情報を設定する。認証確認を伴う場合はAuthenticate系のメソッドを、認証不要な場合はInitializeを呼ぶこと。
'''</remarks>
Public Class HttpConnectionOAuth
    Inherits HttpConnection
    Implements IHttpConnection

    '''<summary>
    '''OAuth署名のoauth_timestamp算出用基準日付（1970/1/1 00:00:00）
    '''</summary>
    Private Shared ReadOnly UnixEpoch As New DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Unspecified)

    '''<summary>
    '''OAuth署名のoauth_nonce算出用乱数クラス
    '''</summary>
    Private Shared ReadOnly NonceRandom As New Random

    '''<summary>
    '''OAuthのアクセストークン。永続化可能（ユーザー取り消しの可能性はある）。
    '''</summary>
    Private token As String = ""

    '''<summary>
    '''OAuthの署名作成用秘密アクセストークン。永続化可能（ユーザー取り消しの可能性はある）。
    '''</summary>
    Private tokenSecret As String = ""

    '''<summary>
    '''OAuthのコンシューマー鍵
    '''</summary>
    Private consumerKey As String

    '''<summary>
    '''OAuthの署名作成用秘密コンシューマーデータ
    '''</summary>
    Private consumerSecret As String

    '''<summary>
    '''認証成功時の応答でユーザー情報を取得する場合のキー。設定しない場合は、AuthUsernameもブランクのままとなる
    '''</summary>
    Private userIdentKey As String

    '''<summary>
    '''OAuthの署名作成用秘密コンシューマーデータ
    '''</summary>
    Private authorizedUsername As String

    '''<summary>
    '''OAuth認証で指定のURLとHTTP通信を行い、結果を返す
    '''</summary>
    '''<param name="method">HTTP通信メソッド（GET/HEAD/POST/PUT/DELETE）</param>
    '''<param name="requestUri">通信先URI</param>
    '''<param name="param">GET時のクエリ、またはPOST時のエンティティボディ</param>
    '''<param name="content">[OUT]HTTP応答のボディデータ</param>
    '''<param name="headerInfo">[IN/OUT]HTTP応答のヘッダ情報。必要なヘッダ名を事前に設定しておくこと</param>
    '''<returns>HTTP応答のステータスコード</returns>
    Public Function GetContent(ByVal method As String, _
            ByVal requestUri As Uri, _
            ByVal param As Dictionary(Of String, String), _
            ByRef content As String, _
            ByVal headerInfo As Dictionary(Of String, String)) As HttpStatusCode Implements IHttpConnection.GetContent
        '認証済かチェック
        If String.IsNullOrEmpty(token) Then Throw New Exception("Sequence error. (Token is blank.)")

        Dim webReq As HttpWebRequest = CreateRequest(method, _
                                                    requestUri, _
                                                    param, _
                                                    False)
        'OAuth認証ヘッダを付加
        AppendOAuthInfo(webReq, param, token, tokenSecret)

        If content Is Nothing Then
            Return GetResponse(webReq, headerInfo, False)
        Else
            Return GetResponse(webReq, content, headerInfo, False)
        End If
    End Function

#Region "認証処理"
    '''<summary>
    '''OAuth認証の開始要求（リクエストトークン取得）。PIN入力用の前段
    '''</summary>
    '''<remarks>
    '''呼び出し元では戻されたurlをブラウザで開き、認証完了後PIN入力を受け付けて、リクエストトークンと共にAuthenticatePinFlowを呼び出す
    '''</remarks>
    '''<param name="requestTokenUrl">リクエストトークンの取得先URL</param>
    '''<param name="requestUri">ブラウザで開く認証用URLのベース</param>
    '''<param name="requestToken">[OUT]認証要求で戻されるリクエストトークン。使い捨て</param>
    '''<param name="authUri">[OUT]requestUriを元に生成された認証用URL。通常はリクエストトークンをクエリとして付加したUri</param>
    '''<returns>取得結果真偽値</returns>
    Public Function AuthenticatePinFlowRequest(ByVal requestTokenUrl As String, _
                                        ByVal authorizeUrl As String, _
                                        ByRef requestToken As String, _
                                        ByRef authUri As Uri) As Boolean
        'PIN-based flow
        authUri = GetAuthenticatePageUri(requestTokenUrl, authorizeUrl, requestToken)
        If authUri Is Nothing Then Return False
        Return True
    End Function

    '''<summary>
    '''OAuth認証のアクセストークン取得。PIN入力用の後段
    '''</summary>
    '''<remarks>
    '''事前にAuthenticatePinFlowRequestを呼んで、ブラウザで認証後に表示されるPINを入力してもらい、その値とともに呼び出すこと
    '''</remarks>
    '''<param name="accessTokenUrl">アクセストークンの取得先URL</param>
    '''<param name="requestUri">AuthenticatePinFlowRequestで取得したリクエストトークン</param>
    '''<param name="pinCode">Webで認証後に表示されるPINコード</param>
    '''<returns>取得結果真偽値</returns>
    Public Function AuthenticatePinFlow(ByVal accessTokenUrl As String, _
                                        ByVal requestToken As String, _
                                        ByVal pinCode As String) As Boolean
        'PIN-based flow
        If String.IsNullOrEmpty(requestToken) Then Throw New Exception("Sequence error.(requestToken is blank)")

        'アクセストークン取得
        Dim accessTokenData As NameValueCollection = GetOAuthToken(New Uri(accessTokenUrl), pinCode, requestToken, Nothing)

        If accessTokenData IsNot Nothing Then
            token = accessTokenData.Item("oauth_token")
            tokenSecret = accessTokenData.Item("oauth_token_secret")
            'サービスごとの独自拡張対応
            If Me.userIdentKey <> "" Then
                authorizedUsername = accessTokenData.Item(Me.userIdentKey)
            Else
                authorizedUsername = ""
            End If
            If token = "" Then Return False
            Return True
        Else
            Return False
        End If
    End Function

    '''<summary>
    '''OAuth認証のアクセストークン取得。xAuth方式
    '''</summary>
    '''<param name="accessTokenUrl">アクセストークンの取得先URL</param>
    '''<param name="username">認証用ユーザー名</param>
    '''<param name="password">認証用パスワード</param>
    '''<returns>取得結果真偽値</returns>
    Public Function AuthenticateXAuth(ByVal accessTokenUrl As String, ByVal username As String, ByVal password As String) As Boolean Implements IHttpConnection.Authenticate
        'ユーザー・パスワードチェック
        If String.IsNullOrEmpty(username) OrElse String.IsNullOrEmpty(password) Then
            Throw New Exception("Sequence error.(username or password is blank)")
        End If
        'xAuthの拡張パラメータ設定
        Dim parameter As New Dictionary(Of String, String)
        parameter.Add("x_auth_mode", "client_auth")
        parameter.Add("x_auth_username", username)
        parameter.Add("x_auth_password", password)

        'アクセストークン取得
        Dim accessTokenData As NameValueCollection = GetOAuthToken(New Uri(accessTokenUrl), "", "", parameter)

        If accessTokenData IsNot Nothing Then
            token = accessTokenData.Item("oauth_token")
            tokenSecret = accessTokenData.Item("oauth_token_secret")
            'サービスごとの独自拡張対応
            If Me.userIdentKey <> "" Then
                authorizedUsername = accessTokenData.Item(Me.userIdentKey)
            Else
                authorizedUsername = ""
            End If
            If token = "" Then Return False
            Return True
        Else
            Return False
        End If
    End Function

    '''<summary>
    '''OAuth認証のリクエストトークン取得。リクエストトークンと組み合わせた認証用のUriも生成する
    '''</summary>
    '''<param name="accessTokenUrl">リクエストトークンの取得先URL</param>
    '''<param name="authorizeUrl">ブラウザで開く認証用URLのベース</param>
    '''<param name="requestToken">[OUT]取得したリクエストトークン</param>
    '''<returns>取得結果真偽値</returns>
    Private Function GetAuthenticatePageUri(ByVal requestTokenUrl As String, _
                                        ByVal authorizeUrl As String, _
                                        ByRef requestToken As String) As Uri
        Const tokenKey As String = "oauth_token"

        'リクエストトークン取得
        Dim reqTokenData As NameValueCollection = GetOAuthToken(New Uri(requestTokenUrl), "", "", Nothing)
        If reqTokenData IsNot Nothing Then
            requestToken = reqTokenData.Item(tokenKey)
            'Uri生成
            Dim ub As New UriBuilder(authorizeUrl)
            ub.Query = String.Format("{0}={1}", tokenKey, requestToken)
            Return ub.Uri
        Else
            Return Nothing
        End If
    End Function

    '''<summary>
    '''OAuth認証のトークン取得共通処理
    '''</summary>
    '''<param name="requestUri">各種トークンの取得先URL</param>
    '''<param name="pinCode">PINフロー時のアクセストークン取得時に設定。それ以外は空文字列</param>
    '''<param name="requestToken">PINフロー時のリクエストトークン取得時に設定。それ以外は空文字列</param>
    '''<param name="parameter">追加パラメータ。xAuthで使用</param>
    '''<returns>取得結果のデータ。正しく取得出来なかった場合はNothing</returns>
    Private Function GetOAuthToken(ByVal requestUri As Uri, ByVal pinCode As String, ByVal requestToken As String, ByVal parameter As Dictionary(Of String, String)) As NameValueCollection
        Dim webReq As HttpWebRequest = Nothing
        'HTTPリクエスト生成。PINコードもパラメータも未指定の場合はGETメソッドで通信。それ以外はPOST
        If String.IsNullOrEmpty(pinCode) AndAlso parameter Is Nothing Then
            webReq = CreateRequest("GET", requestUri, Nothing, False)
        Else
            webReq = CreateRequest("POST", requestUri, parameter, False) 'ボディに追加パラメータ書き込み
        End If
        'OAuth関連パラメータ準備。追加パラメータがあれば追加
        Dim query As New Dictionary(Of String, String)
        If parameter IsNot Nothing Then
            For Each kvp As KeyValuePair(Of String, String) In parameter
                query.Add(kvp.Key, kvp.Value)
            Next
        End If
        'PINコードが指定されていればパラメータに追加
        If Not String.IsNullOrEmpty(pinCode) Then query.Add("oauth_verifier", pinCode)
        'OAuth関連情報をHTTPリクエストに追加
        AppendOAuthInfo(webReq, query, requestToken, "")
        'HTTP応答取得
        Try
            Dim contentText As String = ""
            Dim status As HttpStatusCode = GetResponse(webReq, contentText, Nothing, False)
            If status = HttpStatusCode.OK Then
                Return ParseQueryString(contentText)
            Else
                Return Nothing
            End If
        Catch ex As Exception
            Return Nothing
        End Try
    End Function
#End Region

#Region "OAuth認証用ヘッダ作成・付加処理"
    '''<summary>
    '''HTTPリクエストにOAuth関連ヘッダを追加
    '''</summary>
    '''<param name="webRequest">追加対象のHTTPリクエスト</param>
    '''<param name="query">OAuth追加情報＋クエリ or POSTデータ</param>
    '''<param name="token">アクセストークン、もしくはリクエストトークン。未取得なら空文字列</param>
    '''<param name="tokenSecret">アクセストークンシークレット。認証処理では空文字列</param>
    Private Sub AppendOAuthInfo(ByVal webRequest As HttpWebRequest, _
                                        ByVal query As Dictionary(Of String, String), _
                                        ByVal token As String, _
                                        ByVal tokenSecret As String)
        'OAuth共通情報取得
        Dim parameter As Dictionary(Of String, String) = GetOAuthParameter(token)
        'OAuth共通情報にquery情報を追加
        If query IsNot Nothing Then
            For Each item As KeyValuePair(Of String, String) In query
                parameter.Add(item.Key, item.Value)
            Next
        End If
        '署名の作成・追加
        parameter.Add("oauth_signature", CreateSignature(tokenSecret, webRequest.Method, webRequest.RequestUri, parameter))
        'HTTPリクエストのヘッダに追加
        Dim sb As New StringBuilder("OAuth ")
        For Each item As KeyValuePair(Of String, String) In parameter
            '各種情報のうち、oauth_で始まる情報のみ、ヘッダに追加する。各情報はカンマ区切り、データはダブルクォーテーションで括る
            If item.Key.StartsWith("oauth_") Then
                sb.AppendFormat("{0}=""{1}"",", item.Key, UrlEncode(item.Value))
            End If
        Next
        webRequest.Headers.Add(HttpRequestHeader.Authorization, sb.ToString)
    End Sub

    '''<summary>
    '''OAuthで使用する共通情報を取得する
    '''</summary>
    '''<param name="token">アクセストークン、もしくはリクエストトークン。未取得なら空文字列</param>
    '''<returns>OAuth情報のディクショナリ</returns>
    Private Function GetOAuthParameter(ByVal token As String) As Dictionary(Of String, String)
        Dim parameter As New Dictionary(Of String, String)
        parameter.Add("oauth_consumer_key", consumerKey)
        parameter.Add("oauth_signature_method", "HMAC-SHA1")
        parameter.Add("oauth_timestamp", Convert.ToInt64((DateTime.UtcNow - UnixEpoch).TotalSeconds).ToString())   'epoch秒
        parameter.Add("oauth_nonce", NonceRandom.Next(123400, 9999999).ToString())
        parameter.Add("oauth_version", "1.0")
        If Not String.IsNullOrEmpty(token) Then parameter.Add("oauth_token", token) 'トークンがあれば追加
        Return parameter
    End Function

    '''<summary>
    '''OAuth認証ヘッダの署名作成
    '''</summary>
    '''<param name="tokenSecret">アクセストークン秘密鍵</param>
    '''<param name="method">HTTPメソッド文字列</param>
    '''<param name="uri">アクセス先Uri</param>
    '''<param name="parameter">クエリ、もしくはPOSTデータ</param>
    '''<returns>署名文字列</returns>
    Private Function CreateSignature(ByVal tokenSecret As String, _
                                            ByVal method As String, _
                                            ByVal uri As Uri, _
                                            ByVal parameter As Dictionary(Of String, String) _
                                        ) As String
        'パラメタをソート済みディクショナリに詰替（OAuthの仕様）
        Dim sorted As New SortedDictionary(Of String, String)(parameter)
        'URLエンコード済みのクエリ形式文字列に変換
        Dim paramString As String = CreateQueryString(sorted)
        'アクセス先URLの整形
        Dim url As String = String.Format("{0}://{1}{2}", uri.Scheme, uri.Host, uri.AbsolutePath)
        '署名のベース文字列生成（&区切り）。クエリ形式文字列は再エンコードする
        Dim signatureBase As String = String.Format("{0}&{1}&{2}", method, UrlEncode(url), UrlEncode(paramString))
        '署名鍵の文字列をコンシューマー秘密鍵とアクセストークン秘密鍵から生成（&区切り。アクセストークン秘密鍵なくても&残すこと）
        Dim key As String = UrlEncode(consumerSecret) + "&"
        If Not String.IsNullOrEmpty(tokenSecret) Then key += UrlEncode(tokenSecret)
        '鍵生成＆署名生成
        Dim hmac As New Cryptography.HMACSHA1(Encoding.ASCII.GetBytes(key))
        Dim hash As Byte() = hmac.ComputeHash(Encoding.ASCII.GetBytes(signatureBase))
        Return Convert.ToBase64String(hash)
    End Function

#End Region

    '''<summary>
    '''初期化。各種トークンの設定とユーザー識別情報設定
    '''</summary>
    '''<param name="consumerKey">コンシューマー鍵</param>
    '''<param name="consumerSecret">コンシューマー秘密鍵</param>
    '''<param name="accessToken">アクセストークン</param>
    '''<param name="accessTokenSecret">アクセストークン秘密鍵</param>
    '''<param name="userIdentifier">アクセストークン取得時に得られるユーザー識別情報。不要なら空文字列</param>
    Public Sub Initialize(ByVal consumerKey As String, _
                                    ByVal consumerSecret As String, _
                                    ByVal accessToken As String, _
                                    ByVal accessTokenSecret As String, _
                                    ByVal userIdentifier As String)
        Me.consumerKey = consumerKey
        Me.consumerSecret = consumerSecret
        Me.token = accessToken
        Me.tokenSecret = accessTokenSecret
        Me.userIdentKey = userIdentifier
    End Sub

    '''<summary>
    '''初期化。各種トークンの設定とユーザー識別情報設定
    '''</summary>
    '''<param name="consumerKey">コンシューマー鍵</param>
    '''<param name="consumerSecret">コンシューマー秘密鍵</param>
    '''<param name="accessToken">アクセストークン</param>
    '''<param name="accessTokenSecret">アクセストークン秘密鍵</param>
    '''<param name="username">認証済みユーザー名</param>
    '''<param name="userIdentifier">アクセストークン取得時に得られるユーザー識別情報。不要なら空文字列</param>
    Public Sub Initialize(ByVal consumerKey As String, _
                                ByVal consumerSecret As String, _
                                ByVal accessToken As String, _
                                ByVal accessTokenSecret As String, _
                                ByVal username As String, _
                                ByVal userIdentifier As String)
        Initialize(consumerKey, consumerSecret, accessToken, accessTokenSecret, userIdentifier)
        authorizedUsername = username
    End Sub

    '''<summary>
    '''アクセストークン
    '''</summary>
    Public ReadOnly Property AccessToken() As String
        Get
            Return token
        End Get
    End Property

    '''<summary>
    '''アクセストークン秘密鍵
    '''</summary>
    Public ReadOnly Property AccessTokenSecret() As String
        Get
            Return tokenSecret
        End Get
    End Property

    '''<summary>
    '''認証済みユーザー名
    '''</summary>
    Public ReadOnly Property AuthUsername() As String Implements IHttpConnection.AuthUsername
        Get
            Return authorizedUsername
        End Get
    End Property
End Class

他の類似クラスとの共通化のために定義したインターフェース

Imports System.Net

Public Interface IHttpConnection

    Function GetContent(ByVal method As String, _
            ByVal requestUri As Uri, _
            ByVal param As Dictionary(Of String, String), _
            ByRef content As String, _
            ByVal headerInfo As Dictionary(Of String, String)) As HttpStatusCode

    Function Authenticate(ByVal url As String, ByVal username As String, ByVal password As String) As Boolean

    ReadOnly Property AuthUsername() As String
End Interface