Option Explicit

'---------------------------------------------------

'アクセスする際のエージェント名 -- 任意
Private Const CALLER_NAME = "RECV_HTML"

'一回で受信するデータのサイズ
Private Const SIZE_RECV_BUFFER = 4096　　　'バイト

'---------------------------------------------------

' Win32 Internet関数の初期化
Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
   (ByVal lpszCallerName As String, _
    ByVal dwAccessType As Long, _
    ByVal lpszProxyName As String, _
    ByVal lpszProxyBypass As String, _
    ByVal dwFlags As Long) As Long

' FTP、Gopher、HTTP URLを開く
Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
   (ByVal hInternet As Long, _
    ByVal lpszUrl As String, _
    ByVal lpszHeaders As String, _
    ByVal dwHeadersLength As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext 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 Long

' インターネットハンドルを閉じる
Declare Function InternetCloseHandle Lib "wininet.dll" _
        (ByVal hInternetHandle As Long) As Long

Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_OPEN_TYPE_PROXY = 3

'----- NKFオプション設定 -----
'返却値  エラー：負値　正常：０
Public Declare Function SetNkfOption Lib "Nkf32.dll" _
        (ByVal optStr As String) As Long

'----- 漢字コード変換　-------
'書式　　strOut  出力文字列
'　　　　strIn   入力文字列
Public Declare Sub NkfConvert Lib "Nkf32.dll" _
        (ByRef strOut As Any, ByRef strIn As Any)

'------------------------------------------------------------------------------

Public Function GetHtml(ByVal strUrl As String, ByRef bytRecvData() As Byte, _
     Optional ByVal strProxy As String) As Long
'
'HTTP上のデータを取得
'
'引数　strUrl　　　　　取得したいHTTPのアドレス(URL)を指定
'　　　bytRecvData()　受信したデータを格納するバッファを、Byte型配列で指定
'　　　strProxy　　　　ProxyサーバーのURL（省略可）
'
'戻り値
'    成功　　受信データの総サイズ
'    失敗　　0
'
 Dim hInet As Long          'インターネットハンドル
 Dim hUrl As Long           'URLハンドル
 Dim lngRet As Long         'InternetReadFile の戻り値
 Dim lngSizeTotal As Long   '受信したデータの総サイズ
 Dim lngSizeRecv As Long    '受信したデータのサイズ
 Dim lngSizeBuffer As Long  '受信バッファサイズ
 Dim p As Long              '受信バッファのデータ格納ポインタ
 
    If Len(strUrl) = 0 Then Exit Function
        
    'インターネットハンドルを取得
    If strProxy = "" Then   'Proxyサーバーの指定無し
        hInet = InternetOpen(CALLER_NAME, INTERNET_OPEN_TYPE_PRECONFIG, "", "", 0)
    Else                    'Proxyサーバーが指定
        hInet = InternetOpen(CALLER_NAME, INTERNET_OPEN_TYPE_PROXY, strProxy, "", 0)
    End If
    If hInet = 0 Then GoTo MyEnd    '失敗したら終了

    'URLハンドルを取得
    hUrl = InternetOpenUrl(hInet, strUrl, "", 0, INTERNET_FLAG_RELOAD, 0)
    If hUrl = 0 Then GoTo MyEnd     '失敗したら終了
    
    lngSizeBuffer = SIZE_RECV_BUFFER - 1
    ReDim bytRecvData(lngSizeBuffer)      '受信バッファ確保
    
    Do
        'バッファ拡張（空きが受信単位より小さい時）
        If (lngSizeBuffer - lngSizeTotal) < SIZE_RECV_BUFFER Then '空きが少ない
            lngSizeBuffer = lngSizeBuffer + SIZE_RECV_BUFFER    '受信バッファ拡張
            ReDim Preserve bytRecvData(lngSizeBuffer - 1)
        End If
        
        'データの読み込み
        p = lngSizeTotal '次のデータ格納開始位置
        lngRet = InternetReadFile(hUrl, bytRecvData(p), SIZE_RECV_BUFFER, lngSizeRecv)
        lngSizeTotal = lngSizeTotal + lngSizeRecv '読み込んだデータの総サイズ
        '受信サイズが0、または読み込み失敗の場合は中止
        If (lngSizeRecv = 0) Or (lngRet = 0) Then Exit Do
    Loop
    
    If lngSizeTotal Then '実際にデータが読み込まれた場合
        ReDim Preserve bytRecvData(lngSizeTotal - 1)    '配列サイズを実サイズに削る
        GetHtml = lngSizeTotal                          '読み込んだバイト数を返す
    Else
        Erase bytRecvData '総受信サイズが 0 の場合、配列を消去
    End If
    
MyEnd:
    If hUrl <> 0 Then Call InternetCloseHandle(hUrl) 'URLハンドルを閉じる
    If hInet <> 0 Then Call InternetCloseHandle(hInet) 'インターネットハンドルを閉じる

End Function