インターネットエクスプローラのソースをtxtに保存 (ID:76976)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

インターネットエクスプローラを起動させずに
指定のページをテキストに保存するでは駄目ですか？
WinInetを使えば簡単に出来るので！
一応コード書いとます。

Moduleに
Option Explicit

Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
    (ByVal sAgent As String, _
     ByVal lAccessType As Long, _
     ByVal sProxyName As String, _
     ByVal sProxyBypass As String, _
     ByVal lFlags As Long) As Long

Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
    (ByVal hInternetSession As Long, _
     ByVal sUrl As String, _
     ByVal sHeaders As String, _
     ByVal lHeadersLength As Long, _
     ByVal lFlags As Long, _
     ByVal lContext As Long) As Long

'Declare Function InternetReadFile Lib "wininet.dll" _
'   (ByVal hFile As Long, _
'    ByVal lpBuffer As String, _
'    ByVal lNumBytesToRead As Long, _
'    lpdwNumberOfBytesRead As Long) As Long

Declare Function InternetReadFile Lib "wininet.dll" _
    (ByVal hFile As Long, _
     ByRef lpBuffer As Any, _
     ByVal lNumBytesToRead As Long, _
     ByRef lNumberOfBytesRead As Long) As Integer

Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

フォームにtxtUrlとtxtProxyという名前にテキストボックスを貼り付けてください。
あとCommand1という名前のコマンドボタンを貼り付けの刑？！

フォームに
Option Explicit
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_FLAG_RELOAD = &H80000000

'InternetReadFile で一度に読み込むサイズ
Private Const WI_READ_READSIZE = 1024

'データを受け取るバッファサイズの初期値
'必ず WI_READ_READSIZE 以上のサイズを指定して下さい
Private Const WI_INITBUFSIZE = 32767

'----- GetHttpData -----
'HTTP上のデータを取得します。
'
'引数 strUrl
'   データを取得したいHTTPのアドレス(URL)を指定します。
'
'引数 bytRecvData()
'   受信したデータを格納するバッファを、Byte型配列で指定します。
'   ここに実際に受信したデータが格納されます。
'
'引数 strProxy
'   省略可能です。Proxyサーバーを経由してデータを送受信したい場合、
'   ここに "proxy.hoge.co.jp:8080" のような型式で指定します。
'   省略または "" を渡した場合、レジストリに登録されている
'   アクセス方法で送受信します。
'
'戻り値
'   成功した場合、読み込んだデータの総サイズが返ります。
'   失敗した場合、0 が返ります。
'
Private Function GetHttpData _
    (ByVal strUrl As String, _
     ByRef bytRecvData() As Byte, _
     Optional ByVal strProxy As String) As Long

Dim lngInetHandle   As Long 'インターネットハンドルを格納
    Dim lngUrlHandle    As Long  'URLハンドルを格納
    Dim lngArraySize    As Long  'データを受け取るバッファ bytRecvData のサイズ
    Dim intRet          As Integer     'InternetReadFile の戻り値を格納
    Dim lngTotalRead    As Long  '受信したデータの総サイズ 兼 バッファへのポインタ
    Dim lngReadSize     As Long   '受信したデータのサイズ

If Len(strUrl) = 0 Then Exit Function
 
    '経由するProxyサーバーが指定されている場合
    If Len(strProxy) Then
        'インターネットハンドルを作成
        lngInetHandle = InternetOpen(App.EXEName, _
                                     INTERNET_OPEN_TYPE_PROXY, _
                                     strProxy, _
                                     vbNullString, _
                                     0)
    '経由するProxyサーバーが指定されていない場合
    Else
        'インターネットハンドルを作成
        lngInetHandle = InternetOpen(App.EXEName, _
                                     INTERNET_OPEN_TYPE_PRECONFIG, _
                                     vbNullString, _
                                     vbNullString, _
                                     0)
    End If
    If lngInetHandle = 0 Then Exit Function '失敗したら関数を抜ける

'URLハンドルを作成
    lngUrlHandle = InternetOpenUrl(lngInetHandle, _
                                   strUrl, _
                                   vbNullString, _
                                   0, _
                                   INTERNET_FLAG_RELOAD, _
                                   0)
    If lngUrlHandle = 0 Then GoTo CloseInetHandle '失敗したら CloseInetHandle に飛ぶ
    
    lngArraySize = WI_INITBUFSIZE - 1
    ReDim bytRecvData(lngArraySize) 'バッファの初期サイズを確保する
    
    Do
        '次回受信時、バッファのサイズをオーバーしてしまう危険性がある場合
        If (lngTotalRead + WI_READ_READSIZE) > lngArraySize Then
            'バッファサイズを WI_INITBUFSIZE バイト増やす
            lngArraySize = lngArraySize + WI_INITBUFSIZE
            ReDim Preserve bytRecvData(lngArraySize)
        End If
        'インターネット上のデータを読み込む
        intRet = InternetReadFile(lngUrlHandle, _
                                  bytRecvData(lngTotalRead), _
                                  WI_READ_READSIZE, _
                                  lngReadSize)
        lngTotalRead = lngTotalRead + lngReadSize '読み込んだ総サイズを計算
        '受信サイズが0、または読み込み失敗の場合、ループを抜ける
        If (lngReadSize = 0) Or (intRet = 0) Then Exit Do
    Loop
    
    If lngTotalRead Then '実際にデータが読み込まれた場合
        '配列サイズを実サイズに削る
        ReDim Preserve bytRecvData(lngTotalRead - 1)
        GetHttpData = lngTotalRead '読み込んだバイト数を返す
    Else
        Erase bytRecvData '総受信サイズが 0 の場合、配列を消去
    End If
    
    Call InternetCloseHandle(lngUrlHandle) 'URLハンドルを閉じる

CloseInetHandle:

Call InternetCloseHandle(lngInetHandle) 'インターネットハンドルを閉じる

End Function

Private Sub Command1_Click()
    Dim lngSize         As Long    'GetHttpData()の戻り値(受信サイズ)を格納する
    Dim bytArray()      As Byte 'データを受け取るバッファ(Byte型配列)
    Dim intFileNo       As Integer
    
    'txtUrl で指定したURLのデータを取得
    lngSize = GetHttpData(txtUrl.Text, bytArray(), txtProxy)
    If lngSize Then
        '成功したら、バッファのデータをUnicodeに変換し txtRecvData に表示
        intFileNo = FreeFile
        Open "C:\test.txt" For Output As #intFileNo
        Print #intFileNo, StrConv(bytArray, vbUnicode)
        Close #intFileNo
    End If
End Sub

Private Sub Form_Load()
    txtUrl.Text = "http://oku_newtype.tripod.co.jp/dvd/"
    txtProxy.Text = ""
End Sub

マイクロソフトが提示しているInternetReadFileのコードを見ると
第2引数 sBuffer が、String 型として宣言されてしまっていますので、
このままでは、データを文字列変数に読み込むということになるため、
文字コードが EUC で記述されたページや、
その他画像ファイル等バイナリデータを読み込んだ際に、
データの内容が破壊されてしまいます。
バイナリデータも受け取れるように宣言文を書き換えました。
これでは駄目ですか？

←解決時は質問者本人がここをチェックしてください。

戻る