WEB XMLParser(MSXML)を使いブラウザを通さずにソース情報取得

※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。

※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。

  1. 概要
  2. <Open Method>
    1. HTTPMethod
    2. URL
    3. [readyState Property]
    4. [UserName]
    5. [Password]
  3. <abort Method>
  4. <send Method>
  5. <status Prroperty>
  6. <statusText Property>
  7. <getResponseHeader Method>
  8. <getAllResponseHeaders Method>
  9. <setRequestHeader Method>
  10. <responseBody Property>
  11. <responseStream Property>
  12. <responseTerxt Property>
  13. <responseXML Property>
  14. <statusText Property>
  15. <onreadystatechange Event>
  16. <onload Event>
  17. VBVBAサンプル
XMLHTTPクラスとXMLHttpRequestクラスの利用

XMLHTTPオブジェクトを生成します

概要

  • [Msxml2.XMLHTTP]
    • 動作 IE4~IE6 動作 WindowsXP以上
      • Object = new ActiveXObject("Msxml2.XMLHTTP");
      • Object = CreateObject("MSXML2.XMLHTTP")
  • [Microsoft.XMLHTTP]
    • 動作 IE4~IE6 動作 WindowsXP以下
      • Object = new ActiveXObject("Microsoft.XMLHTTP");
      • Object = CreateObject("Microsoft.XMLHTTP")
  • [XMLHttpRequest]
    • 動作 IE4~IE6以外
      • Object = new ActiveXObject("Msxml.XMLHTTPRequest");
      • Object = CreateObject("MSXML.XMLHTTPRequest")
  • XMLHTTPオブジェクト
  • XMLファイル構文解析ライブラリ
  • XML Parser
  • XML対応COMコンポーネント(Microsoft)オブジェクト
  • XML処理のためのライブラリ
  • ActiveXコントロールとして利用
  • 保存先
    • C:\WINDOWS\system32
  • 参考 http://msdn.microsoft.com/ja-jp/library/bb902797.aspx

<Open Method>

  • 戻り値なし
  • 動作
    • リクエストの初期化 (リクエストの設定)
    • MSXMLx.XMLHTTP.open HTTPMethod,URL *Option[,readyState,UserName,Password]
  • HTTPMethod
    • GET,POST,PUT,PROPFINDが指定可能
    • データ取得GETを指定
    • データ送信POSTを指定
  • URL
    • URLを指定
  • *Option[]内は省略可能
    • *Option
      [readyState Property]
    • 省略した場合はデフォルトのtrue(非同期)が適用されます
      • true
        • 非同期 データの送受信完了まで処理しない(規定値)
        • サーバーにリクエスト中の処理状態を取得
        • 戻り値 説明
          0 uninitialized 開始前の初期状態
          1 loading リクエスト準備中
          2 loaded リクエスト送信中
          3 Interactive データ受信中データ解析中
          4 complete データ受信解析完了又は失敗
      • false
        • 同期 データを取得した時点で処理
    • *Option
      [UserName]
      • 認証ダイアログ表示
      • 省略可能 UserName ドメイン名\ユーザーID ドメイン認証
    • Option
      [Password]
      • 認証ダイアログ表示
      • 省略可能 Password パスワード ドメイン認証

<abort Method>

  • リクエストをキャンセル
  • 戻り値なし
    • MSXMLx.xmlHttp.abort

<send Method>

  • サーバーにリクエストを送信
  • 戻り値なし
    • MSXMLx.xmlHttp.send (Argument)
  • 引数 Argument
    • Post (文字), DOM, InputStreamが指定可能
    • GET送信の場合は空文字列("")又はNULL値を指定
    • Post (文字)
      • サーバーサイドスクリプトで受け取ったデータを処理させる場合
  • リクエストファイルのダウンロード完了後
    • リクエストの返り値(レスポンスデータ)を取得することが可能
    • プロパティ
      • responseXML XML形式で取得
      • responseText テキスト形式で取得

<status Property>

  • HTTPステータスコード(レスポンス) Status-Code
  • Code
    • MSXMLx.xmlHttp.status
  • HTTP HTTPステータスコード(レスポンス)一覧

<statusText Property>

  • HTTPステータスコード(レスポンス) Reason-Phrase
  • Text
    • MSXMLx.xmlHttp.statusText
  • HTTP HTTPステータスコード(レスポンス)一覧

<getResponseHeader Method>

  • 指定したレスポンスヘッダを取得
  • ヘッダがない場合はNULLを返します
  • すべてのヘッダを取得する場合には<getAllResponseHeaders Method>
    • MSXMLx.xmlHttp.getResponseHeader (Argument)
    • 引数Argumentにはヘッダ名を指定

<getAllResponseHeaders Method>

  • すべてのレスポンスヘッダを取得
  • ヘッダがない場合はNULLを返します
  • 特定のヘッダを取得する場合には<getResponseHeader Method>
    • MSXMLx.xmlHttp.getAllResponseHeaders

<setRequestHeader Method>

  • 特定のリクエストヘッダを設定。
    • MSXMLx.XMLHTTP.setRequestHeader(Argument1,Argument2)
    • 引数Argument1にはヘッダ名
    • 引数Argument2には値を指定

<responseBody Property>

  • バイナリデータを取得
  • レスポンスをバイト配列取得
  • IE のみで使用可

<responseStream Property>

  • レスポンスを IStream 形式取得
  • IE のみで使用可

<responseText Property>

  • レスポンスをテキスト形式取得。

<responseXML Property>

  • レスポンスを XML DOM 形式取得。

<statusText Property>

  • HTTPステータスの詳細取得

<onreadystatechange Event>

  • [readyState Property] をtrueにした場合に使用
  • [readyState Property] が変化する度に呼び出されるイベントハンドラ
  • Microsoft Visual Basic または Visual C++ ですぐにアクセスできません
  • 問題解決:http://support.microsoft.com/kb/303322/ja

<onload Event>

  • レスポンスデータのダウンロード完了後に発生
  • IEでの使用は未対応
  • IEでの使用は<onreadystatechange Event>を使用する

 

VB・VBAサンプル

Option Explicit


Sub GetMSXML(ByRef objMSXML As ObjectByRef blnErr As Boolean)
'***************************************************
'XML_Parser(MSXML)をObject定義する
'***************************************************
'リロードを伴わずにソース情報取得
'元々はXML形式のデータのやり取りを行うもの
'XML Parser
'JavaScriptではAjax(Asynchronous JavaScript + XML)

On Error Resume Next
    Set objMSXML = CreateObject("MSXML2.XMLHTTP") 'MSXML2Class
    If (Err.Number <> 0) Then
        Set objMSXML = CreateObject("Microsoft.XMLHTTP")
            If (Err.Number <> 0) Then
                Set objMSXML = CreateObject("MSXML.XMLHTTPRequest")
            End If
    End If

On Error GoTo 0
    If objMSXML Is Nothing Then
        blnErr = True
    Else
        blnErr = False
    End If

End Sub


Private Sub test_UserNamePassword()
'*********************************************
'同期 データを取得した時点で処理
'*********************************************
'*********************************************
'"UserName", "Password"を設置
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, False, "UserName", "Password"
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If
End With

End Sub


Private Sub test_readyState()
'*********************************************
'サーバーにリクエスト中の処理状態を取得
'*********************************************
Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If
End With

End Sub


Private Sub test_getResponseHeader()
'*********************************************
'レスポンスヘッダ取得
'*********************************************
Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String
Dim lngStatus As Long, strSRC(5) As String
Dim blnRspns As Boolean
'パラメータ
strURL = "http://www.yahoo.co.jp/"

'全部のレスポンスヘッダ取得 =True
'個別のレスポンスヘッダ取得 =False
blnRspns = False

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If

    lngStatus = .status
    If (.status < 200 Or .status >= 300) Then
        Debug.Print lngStatus & vbTab & strStatus
        Exit Sub
    Else
        Debug.Print lngStatus & vbTab & strStatus
    End If

    If blnRspns = True Then
        strSRC(0) = .getAllResponseHeaders
    Else
        strSRC(1) = .getResponseHeader("ETag")
        strSRC(2) = .getResponseHeader("Content-Length")
        strSRC(3) = .getResponseHeader("Keep-Alive")
        strSRC(4) = .getResponseHeader("Content-Type")
        strSRC(5) = .getResponseHeader("Last-Modified")
    End If

    Dim i As Byte

    For i = 0 To 5
    Debug.Print strSRC(i)
    Next i

End With

End Sub


Private Sub test_responseXMLText()
'*********************************************
'XML又はTextで取得する
'*********************************************
'*********************************************
'Shift -JISをUnicodeに変換
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String
Dim lngStatus As Long, strStatus As String, strSRC As String
Dim XMLTXT As Byte, blnSJIS As Boolean

'パラメータ
strURL = "http://www.yahoo.co.jp/"

'パラメータ
'XMLデータ(responseXML) = 0
'TXTデータ(responseText) = 1
XMLTXT = 1

'パラメータ
'Shift-JIS  の場合 = True
'Unicode    の場合 = False
blnSJIS = False

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        DoEvents
        GoTo reTry:
    End If

    lngStatus = .status
    strStatus = .statusText
    If (.status < 200 Or .status >= 300) Then
        Debug.Print lngStatus & vbTab & strStatus
        Exit Sub
    Else
        Debug.Print lngStatus & vbTab & strStatus
    End If

    If XMLTXT = 0 Then
        'XML形式以外はエラーになります。
        strSRC = .responseXML
    Else
        strSRC = .responseText
    End If

    If blnSJIS = True Then
        strSRC = StrConv(.responseBody, vbUnicode)
    Else
        strSRC = .responseText
    End If

    Debug.Print strSRC
End With

End Sub


Private Sub test_abort()
'*********************************************
'中止する
'*********************************************

Dim objMSXML As Object, blnErr As Boolean
Dim strURL As String

'パラメータ
strURL = "http://www.yahoo.co.jp/"

Call GetMSXML(objMSXML, blnErr)

If blnErr = True Then Exit Sub

With objMSXML
    .Open "GET", strURL, True
    .send
reTry:
    If .readyState <> 4 Then
        Debug.Print .readyState
        DoEvents
        GoTo reTry:
    Else
        Debug.Print .readyState
    End If

    .abort
    MsgBox "Cancel!"
End With

End Sub

 

2000年01月01日|[VBサンプルコード]:[WEB]